@@ -30,9 +30,55 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30
30
#include "keymap.h"
31
31
32
32
enum case_action {CASE_UP , CASE_DOWN , CASE_CAPITALIZE , CASE_CAPITALIZE_UP };
33
+
34
+ /* State for casing individual characters. */
35
+ struct casing_context {
36
+ /* User-requested action. */
37
+ enum case_action flag ;
38
+ /* If true, function operates on a buffer as opposed to a string or character.
39
+ When run on a buffer, syntax_prefix_flag_p is taken into account when
40
+ determined inword flag. */
41
+ bool inbuffer ;
42
+ /* Conceptually, this denotes whether we are inside of a word except
43
+ that if flag is CASE_UP it’s always false and if flag is CASE_DOWN
44
+ this is always true. */
45
+ bool inword ;
46
+ };
47
+
48
+ /* Initialise CTX structure for casing characters. */
49
+ static void
50
+ prepare_casing_context (struct casing_context * ctx ,
51
+ enum case_action flag , bool inbuffer )
52
+ {
53
+ ctx -> flag = flag ;
54
+ ctx -> inbuffer = inbuffer ;
55
+ ctx -> inword = flag == CASE_DOWN ;
56
+
57
+ /* If the case table is flagged as modified, rescan it. */
58
+ if (NILP (XCHAR_TABLE (BVAR (current_buffer , downcase_table ))-> extras [1 ]))
59
+ Fset_case_table (BVAR (current_buffer , downcase_table ));
60
+
61
+ if (inbuffer && (int ) flag >= (int ) CASE_CAPITALIZE )
62
+ SETUP_BUFFER_SYNTAX_TABLE (); /* For syntax_prefix_flag_p. */
63
+ }
64
+
65
+ /* Based on CTX, case character CH accordingly. Update CTX as necessary.
66
+ Return cased character. */
67
+ static int
68
+ case_character (struct casing_context * ctx , int ch )
69
+ {
70
+ if (ctx -> inword )
71
+ ch = ctx -> flag == CASE_CAPITALIZE_UP ? ch : downcase (ch );
72
+ else
73
+ ch = upcase (ch );
74
+ if ((int ) ctx -> flag >= (int ) CASE_CAPITALIZE )
75
+ ctx -> inword = SYNTAX (ch ) == Sword &&
76
+ (!ctx -> inbuffer || ctx -> inword || !syntax_prefix_flag_p (ch ));
77
+ return ch ;
78
+ }
33
79
34
80
static Lisp_Object
35
- do_casify_natnum (enum case_action flag , Lisp_Object obj )
81
+ do_casify_natnum (struct casing_context * ctx , Lisp_Object obj )
36
82
{
37
83
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
38
84
| CHAR_SHIFT | CHAR_CTL | CHAR_META );
@@ -55,7 +101,7 @@ do_casify_natnum (enum case_action flag, Lisp_Object obj)
55
101
|| !NILP (BVAR (current_buffer , enable_multibyte_characters ));
56
102
if (! multibyte )
57
103
MAKE_CHAR_MULTIBYTE (ch );
58
- cased = flag == CASE_DOWN ? downcase ( ch ) : upcase ( ch );
104
+ cased = case_character ( ctx , ch );
59
105
if (cased == ch )
60
106
return obj ;
61
107
@@ -66,10 +112,9 @@ do_casify_natnum (enum case_action flag, Lisp_Object obj)
66
112
}
67
113
68
114
static Lisp_Object
69
- do_casify_multibyte_string (enum case_action flag , Lisp_Object obj )
115
+ do_casify_multibyte_string (struct casing_context * ctx , Lisp_Object obj )
70
116
{
71
117
ptrdiff_t i , i_byte , size = SCHARS (obj );
72
- bool inword = flag == CASE_DOWN ;
73
118
int len , ch , cased ;
74
119
USE_SAFE_ALLOCA ;
75
120
ptrdiff_t o_size ;
@@ -83,14 +128,7 @@ do_casify_multibyte_string (enum case_action flag, Lisp_Object obj)
83
128
if (o_size - MAX_MULTIBYTE_LENGTH < o - dst )
84
129
string_overflow ();
85
130
ch = STRING_CHAR_AND_LENGTH (SDATA (obj ) + i_byte , len );
86
- if (inword && flag != CASE_CAPITALIZE_UP )
87
- cased = downcase (ch );
88
- else if (!inword || flag != CASE_CAPITALIZE_UP )
89
- cased = upcase (ch );
90
- else
91
- cased = ch ;
92
- if ((int ) flag >= (int ) CASE_CAPITALIZE )
93
- inword = (SYNTAX (ch ) == Sword );
131
+ cased = case_character (ctx , ch );
94
132
o += CHAR_STRING (cased , o );
95
133
}
96
134
eassert (o - dst <= o_size );
@@ -100,52 +138,43 @@ do_casify_multibyte_string (enum case_action flag, Lisp_Object obj)
100
138
}
101
139
102
140
static Lisp_Object
103
- do_casify_unibyte_string (enum case_action flag , Lisp_Object obj )
141
+ do_casify_unibyte_string (struct casing_context * ctx , Lisp_Object obj )
104
142
{
105
143
ptrdiff_t i , size = SCHARS (obj );
106
- bool inword = flag == CASE_DOWN ;
107
144
int ch , cased ;
108
145
109
146
obj = Fcopy_sequence (obj );
110
147
for (i = 0 ; i < size ; i ++ )
111
148
{
112
149
ch = SREF (obj , i );
113
150
MAKE_CHAR_MULTIBYTE (ch );
114
- cased = ch ;
115
- if (inword && flag != CASE_CAPITALIZE_UP )
116
- ch = downcase (ch );
117
- else if (!uppercasep (ch )
118
- && (!inword || flag != CASE_CAPITALIZE_UP ))
119
- ch = upcase (cased );
120
- if ((int ) flag >= (int ) CASE_CAPITALIZE )
121
- inword = (SYNTAX (ch ) == Sword );
151
+ cased = case_character (ctx , ch );
122
152
if (ch == cased )
123
153
continue ;
124
- MAKE_CHAR_UNIBYTE (ch );
154
+ MAKE_CHAR_UNIBYTE (cased );
125
155
/* If the char can't be converted to a valid byte, just don't change it */
126
- if (ch >= 0 && ch < 256 )
127
- SSET (obj , i , ch );
156
+ if (cased >= 0 && cased < 256 )
157
+ SSET (obj , i , cased );
128
158
}
129
159
return obj ;
130
160
}
131
161
132
162
static Lisp_Object
133
163
casify_object (enum case_action flag , Lisp_Object obj )
134
164
{
135
- /* If the case table is flagged as modified, rescan it. */
136
- if (NILP (XCHAR_TABLE (BVAR (current_buffer , downcase_table ))-> extras [1 ]))
137
- Fset_case_table (BVAR (current_buffer , downcase_table ));
165
+ struct casing_context ctx ;
166
+ prepare_casing_context (& ctx , flag , false);
138
167
139
168
if (NATNUMP (obj ))
140
- return do_casify_natnum (flag , obj );
169
+ return do_casify_natnum (& ctx , obj );
141
170
else if (!STRINGP (obj ))
142
171
wrong_type_argument (Qchar_or_string_p , obj );
143
172
else if (!SCHARS (obj ))
144
173
return obj ;
145
174
else if (STRING_MULTIBYTE (obj ))
146
- return do_casify_multibyte_string (flag , obj );
175
+ return do_casify_multibyte_string (& ctx , obj );
147
176
else
148
- return do_casify_unibyte_string (flag , obj );
177
+ return do_casify_unibyte_string (& ctx , obj );
149
178
}
150
179
151
180
DEFUN ("upcase" , Fupcase , Supcase , 1 , 1 , 0 ,
@@ -196,8 +225,6 @@ The argument object is not altered--the value is a copy. */)
196
225
static void
197
226
casify_region (enum case_action flag , Lisp_Object b , Lisp_Object e )
198
227
{
199
- int c ;
200
- bool inword = flag == CASE_DOWN ;
201
228
bool multibyte = !NILP (BVAR (current_buffer , enable_multibyte_characters ));
202
229
ptrdiff_t start , end ;
203
230
ptrdiff_t start_byte ;
@@ -208,66 +235,57 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
208
235
ptrdiff_t opoint = PT ;
209
236
ptrdiff_t opoint_byte = PT_BYTE ;
210
237
238
+ struct casing_context ctx ;
239
+
211
240
if (EQ (b , e ))
212
241
/* Not modifying because nothing marked */
213
242
return ;
214
243
215
- /* If the case table is flagged as modified, rescan it. */
216
- if (NILP (XCHAR_TABLE (BVAR (current_buffer , downcase_table ))-> extras [1 ]))
217
- Fset_case_table (BVAR (current_buffer , downcase_table ));
218
-
219
244
validate_region (& b , & e );
220
245
start = XFASTINT (b );
221
246
end = XFASTINT (e );
222
247
modify_text (start , end );
223
248
record_change (start , end - start );
224
249
start_byte = CHAR_TO_BYTE (start );
225
250
226
- SETUP_BUFFER_SYNTAX_TABLE (); /* For syntax_prefix_flag_p. */
251
+ prepare_casing_context ( & ctx , flag , true);
227
252
228
253
while (start < end )
229
254
{
230
- int c2 , len ;
255
+ int ch , cased , len ;
231
256
232
257
if (multibyte )
233
258
{
234
- c = FETCH_MULTIBYTE_CHAR (start_byte );
235
- len = CHAR_BYTES (c );
259
+ ch = FETCH_MULTIBYTE_CHAR (start_byte );
260
+ len = CHAR_BYTES (ch );
236
261
}
237
262
else
238
263
{
239
- c = FETCH_BYTE (start_byte );
240
- MAKE_CHAR_MULTIBYTE (c );
264
+ ch = FETCH_BYTE (start_byte );
265
+ MAKE_CHAR_MULTIBYTE (ch );
241
266
len = 1 ;
242
267
}
243
- c2 = c ;
244
- if (inword && flag != CASE_CAPITALIZE_UP )
245
- c = downcase (c );
246
- else if (!inword || flag != CASE_CAPITALIZE_UP )
247
- c = upcase (c );
248
- if ((int ) flag >= (int ) CASE_CAPITALIZE )
249
- inword = ((SYNTAX (c ) == Sword )
250
- && (inword || !syntax_prefix_flag_p (c )));
251
- if (c != c2 )
268
+ cased = case_character (& ctx , ch );
269
+ if (ch != cased )
252
270
{
253
271
last = start ;
254
272
if (first < 0 )
255
273
first = start ;
256
274
257
275
if (! multibyte )
258
276
{
259
- MAKE_CHAR_UNIBYTE (c );
260
- FETCH_BYTE (start_byte ) = c ;
277
+ MAKE_CHAR_UNIBYTE (cased );
278
+ FETCH_BYTE (start_byte ) = cased ;
261
279
}
262
- else if (ASCII_CHAR_P (c2 ) && ASCII_CHAR_P (c ))
263
- FETCH_BYTE (start_byte ) = c ;
280
+ else if (ASCII_CHAR_P (cased ) && ASCII_CHAR_P (ch ))
281
+ FETCH_BYTE (start_byte ) = cased ;
264
282
else
265
283
{
266
- int tolen = CHAR_BYTES (c );
284
+ int tolen = CHAR_BYTES (cased );
267
285
int j ;
268
286
unsigned char str [MAX_MULTIBYTE_LENGTH ];
269
287
270
- CHAR_STRING (c , str );
288
+ CHAR_STRING (cased , str );
271
289
if (len == tolen )
272
290
{
273
291
/* Length is unchanged. */
0 commit comments