Mercurial > emacs
annotate src/casefiddle.c @ 6668:5ab295d49e7f
(generate-calendar-month): Add mouse-face properties.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 04 Apr 1994 22:59:59 +0000 |
parents | c2d29681d218 |
children | cd81dba38a49 |
rev | line source |
---|---|
118 | 1 /* GNU Emacs case conversion functions. |
2 Copyright (C) 1985 Free Software Foundation, Inc. | |
3 | |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 1, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
2822
diff
changeset
|
21 #include <config.h> |
118 | 22 #include "lisp.h" |
23 #include "buffer.h" | |
24 #include "commands.h" | |
25 #include "syntax.h" | |
26 | |
27 enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; | |
28 | |
29 Lisp_Object | |
30 casify_object (flag, obj) | |
31 enum case_action flag; | |
32 Lisp_Object obj; | |
33 { | |
34 register int i, c, len; | |
35 register int inword = flag == CASE_DOWN; | |
36 | |
37 while (1) | |
38 { | |
39 if (XTYPE (obj) == Lisp_Int) | |
40 { | |
41 c = XINT (obj); | |
42 if (c >= 0 && c <= 0400) | |
43 { | |
44 if (inword) | |
45 XFASTINT (obj) = DOWNCASE (c); | |
46 else if (!UPPERCASEP (c)) | |
47 XFASTINT (obj) = UPCASE1 (c); | |
48 } | |
49 return obj; | |
50 } | |
51 if (XTYPE (obj) == Lisp_String) | |
52 { | |
53 obj = Fcopy_sequence (obj); | |
54 len = XSTRING (obj)->size; | |
55 for (i = 0; i < len; i++) | |
56 { | |
57 c = XSTRING (obj)->data[i]; | |
58 if (inword) | |
59 c = DOWNCASE (c); | |
60 else if (!UPPERCASEP (c)) | |
61 c = UPCASE1 (c); | |
62 XSTRING (obj)->data[i] = c; | |
63 if (flag == CASE_CAPITALIZE) | |
64 inword = SYNTAX (c) == Sword; | |
65 } | |
66 return obj; | |
67 } | |
1926
952f2a18f83d
* callint.c (Fcall_interactively): Pass the correct number of
Jim Blandy <jimb@redhat.com>
parents:
1505
diff
changeset
|
68 obj = wrong_type_argument (Qchar_or_string_p, obj); |
118 | 69 } |
70 } | |
71 | |
72 DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, | |
73 "Convert argument to upper case and return that.\n\ | |
74 The argument may be a character or string. The result has the same type.\n\ | |
75 The argument object is not altered. See also `capitalize'.") | |
76 (obj) | |
77 Lisp_Object obj; | |
78 { | |
79 return casify_object (CASE_UP, obj); | |
80 } | |
81 | |
82 DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, | |
83 "Convert argument to lower case and return that.\n\ | |
84 The argument may be a character or string. The result has the same type.\n\ | |
85 The argument object is not altered.") | |
86 (obj) | |
87 Lisp_Object obj; | |
88 { | |
89 return casify_object (CASE_DOWN, obj); | |
90 } | |
91 | |
92 DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, | |
93 "Convert argument to capitalized form and return that.\n\ | |
94 This means that each word's first character is upper case\n\ | |
95 and the rest is lower case.\n\ | |
96 The argument may be a character or string. The result has the same type.\n\ | |
97 The argument object is not altered.") | |
98 (obj) | |
99 Lisp_Object obj; | |
100 { | |
101 return casify_object (CASE_CAPITALIZE, obj); | |
102 } | |
103 | |
104 /* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. | |
105 b and e specify range of buffer to operate on. */ | |
106 | |
107 casify_region (flag, b, e) | |
108 enum case_action flag; | |
109 Lisp_Object b, e; | |
110 { | |
111 register int i; | |
112 register int c; | |
113 register int inword = flag == CASE_DOWN; | |
114 | |
115 if (EQ (b, e)) | |
116 /* Not modifying because nothing marked */ | |
117 return; | |
118 | |
119 validate_region (&b, &e); | |
2783
789c11177579
The text property routines can now modify buffers other
Jim Blandy <jimb@redhat.com>
parents:
1926
diff
changeset
|
120 modify_region (current_buffer, XFASTINT (b), XFASTINT (e)); |
2822
153a269b1315
(casify_region): Remove mistaken arg to record_change.
Richard M. Stallman <rms@gnu.org>
parents:
2783
diff
changeset
|
121 record_change (XFASTINT (b), XFASTINT (e) - XFASTINT (b)); |
118 | 122 |
123 for (i = XFASTINT (b); i < XFASTINT (e); i++) | |
124 { | |
125 c = FETCH_CHAR (i); | |
126 if (inword && flag != CASE_CAPITALIZE_UP) | |
127 c = DOWNCASE (c); | |
128 else if (!UPPERCASEP (c) | |
129 && (!inword || flag != CASE_CAPITALIZE_UP)) | |
130 c = UPCASE1 (c); | |
131 FETCH_CHAR (i) = c; | |
132 if ((int) flag >= (int) CASE_CAPITALIZE) | |
133 inword = SYNTAX (c) == Sword; | |
134 } | |
135 | |
136 signal_after_change (XFASTINT (b), | |
137 XFASTINT (e) - XFASTINT (b), | |
138 XFASTINT (e) - XFASTINT (b)); | |
139 } | |
140 | |
141 DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 2, "r", | |
142 "Convert the region to upper case. In programs, wants two arguments.\n\ | |
143 These arguments specify the starting and ending character numbers of\n\ | |
144 the region to operate on. When used as a command, the text between\n\ | |
145 point and the mark is operated on.\n\ | |
146 See also `capitalize-region'.") | |
147 (b, e) | |
148 Lisp_Object b, e; | |
149 { | |
150 casify_region (CASE_UP, b, e); | |
151 return Qnil; | |
152 } | |
153 | |
154 DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", | |
155 "Convert the region to lower case. In programs, wants two arguments.\n\ | |
156 These arguments specify the starting and ending character numbers of\n\ | |
157 the region to operate on. When used as a command, the text between\n\ | |
158 point and the mark is operated on.") | |
159 (b, e) | |
160 Lisp_Object b, e; | |
161 { | |
162 casify_region (CASE_DOWN, b, e); | |
163 return Qnil; | |
164 } | |
165 | |
166 DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 2, "r", | |
167 "Convert the region to capitalized form.\n\ | |
168 Capitalized form means each word's first character is upper case\n\ | |
169 and the rest of it is lower case.\n\ | |
170 In programs, give two arguments, the starting and ending\n\ | |
171 character positions to operate on.") | |
172 (b, e) | |
173 Lisp_Object b, e; | |
174 { | |
175 casify_region (CASE_CAPITALIZE, b, e); | |
176 return Qnil; | |
177 } | |
178 | |
179 /* Like Fcapitalize but change only the initials. */ | |
180 | |
181 Lisp_Object | |
182 upcase_initials_region (b, e) | |
183 Lisp_Object b, e; | |
184 { | |
185 casify_region (CASE_CAPITALIZE_UP, b, e); | |
186 return Qnil; | |
187 } | |
188 | |
189 Lisp_Object | |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
190 operate_on_word (arg, newpoint) |
118 | 191 Lisp_Object arg; |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
192 int *newpoint; |
118 | 193 { |
1505
4f138b03e5ab
* casefiddle.c (operate_on_word): Declare end to be an int, not a
Jim Blandy <jimb@redhat.com>
parents:
484
diff
changeset
|
194 Lisp_Object val; |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
195 int farend; |
118 | 196 |
197 CHECK_NUMBER (arg, 0); | |
198 farend = scan_words (point, XINT (arg)); | |
199 if (!farend) | |
200 farend = XINT (arg) > 0 ? ZV : BEGV; | |
201 | |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
202 *newpoint = point > farend ? point : farend; |
118 | 203 XFASTINT (val) = farend; |
204 | |
205 return val; | |
206 } | |
207 | |
208 DEFUN ("upcase-word", Fupcase_word, Supcase_word, 1, 1, "p", | |
209 "Convert following word (or ARG words) to upper case, moving over.\n\ | |
210 With negative argument, convert previous words but do not move.\n\ | |
211 See also `capitalize-word'.") | |
212 (arg) | |
213 Lisp_Object arg; | |
214 { | |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
215 Lisp_Object beg, end; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
216 int newpoint; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
217 XFASTINT (beg) = point; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
218 end = operate_on_word (arg, &newpoint); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
219 casify_region (CASE_UP, beg, end); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
220 SET_PT (newpoint); |
118 | 221 return Qnil; |
222 } | |
223 | |
224 DEFUN ("downcase-word", Fdowncase_word, Sdowncase_word, 1, 1, "p", | |
225 "Convert following word (or ARG words) to lower case, moving over.\n\ | |
226 With negative argument, convert previous words but do not move.") | |
227 (arg) | |
228 Lisp_Object arg; | |
229 { | |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
230 Lisp_Object beg, end; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
231 int newpoint; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
232 XFASTINT (beg) = point; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
233 end = operate_on_word (arg, &newpoint); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
234 casify_region (CASE_DOWN, beg, end); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
235 SET_PT (newpoint); |
118 | 236 return Qnil; |
237 } | |
238 | |
239 DEFUN ("capitalize-word", Fcapitalize_word, Scapitalize_word, 1, 1, "p", | |
240 "Capitalize the following word (or ARG words), moving over.\n\ | |
241 This gives the word(s) a first character in upper case\n\ | |
242 and the rest lower case.\n\ | |
243 With negative argument, capitalize previous words but do not move.") | |
244 (arg) | |
245 Lisp_Object arg; | |
246 { | |
6221
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
247 Lisp_Object beg, end; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
248 int newpoint; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
249 XFASTINT (beg) = point; |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
250 end = operate_on_word (arg, &newpoint); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
251 casify_region (CASE_CAPITALIZE, beg, end); |
c2d29681d218
(operate_on_word): Don't move point; store in *NEWPOINT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
252 SET_PT (newpoint); |
118 | 253 return Qnil; |
254 } | |
255 | |
256 syms_of_casefiddle () | |
257 { | |
258 defsubr (&Supcase); | |
259 defsubr (&Sdowncase); | |
260 defsubr (&Scapitalize); | |
261 defsubr (&Supcase_region); | |
262 defsubr (&Sdowncase_region); | |
263 defsubr (&Scapitalize_region); | |
264 defsubr (&Supcase_word); | |
265 defsubr (&Sdowncase_word); | |
266 defsubr (&Scapitalize_word); | |
267 } | |
268 | |
269 keys_of_casefiddle () | |
270 { | |
271 initial_define_key (control_x_map, Ctl('U'), "upcase-region"); | |
484 | 272 Fput (intern ("upcase-region"), Qdisabled, Qt); |
118 | 273 initial_define_key (control_x_map, Ctl('L'), "downcase-region"); |
484 | 274 Fput (intern ("downcase-region"), Qdisabled, Qt); |
275 | |
118 | 276 initial_define_key (meta_map, 'u', "upcase-word"); |
277 initial_define_key (meta_map, 'l', "downcase-word"); | |
278 initial_define_key (meta_map, 'c', "capitalize-word"); | |
279 } |