|
428
|
1 /* Code conversion functions.
|
|
|
2 Copyright (C) 1991, 1995 Free Software Foundation, Inc.
|
|
|
3 Copyright (C) 1995 Sun Microsystems, Inc.
|
|
|
4
|
|
|
5 This file is part of XEmacs.
|
|
|
6
|
|
|
7 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
8 under the terms of the GNU General Public License as published by the
|
|
|
9 Free Software Foundation; either version 2, or (at your option) any
|
|
|
10 later version.
|
|
|
11
|
|
|
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
15 for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with XEmacs; see the file COPYING. If not, write to
|
|
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 Boston, MA 02111-1307, USA. */
|
|
|
21
|
|
|
22 /* Synched up with: Mule 2.3. Not in FSF. */
|
|
|
23
|
|
|
24 /* Rewritten by Ben Wing <ben@xemacs.org>. */
|
|
|
25
|
|
|
26 #include <config.h>
|
|
|
27 #include "lisp.h"
|
|
|
28
|
|
|
29 #include "buffer.h"
|
|
|
30 #include "elhash.h"
|
|
|
31 #include "insdel.h"
|
|
|
32 #include "lstream.h"
|
|
440
|
33 #include "opaque.h"
|
|
428
|
34 #ifdef MULE
|
|
|
35 #include "mule-ccl.h"
|
|
|
36 #include "chartab.h"
|
|
|
37 #endif
|
|
|
38 #include "file-coding.h"
|
|
|
39
|
|
563
|
40 Lisp_Object Qtext_conversion_error;
|
|
428
|
41
|
|
|
42 Lisp_Object Vkeyboard_coding_system;
|
|
|
43 Lisp_Object Vterminal_coding_system;
|
|
|
44 Lisp_Object Vcoding_system_for_read;
|
|
|
45 Lisp_Object Vcoding_system_for_write;
|
|
|
46 Lisp_Object Vfile_name_coding_system;
|
|
|
47
|
|
|
48 /* Table of symbols identifying each coding category. */
|
|
448
|
49 Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST];
|
|
428
|
50
|
|
|
51
|
|
|
52
|
|
|
53 struct file_coding_dump {
|
|
|
54 /* Coding system currently associated with each coding category. */
|
|
448
|
55 Lisp_Object coding_category_system[CODING_CATEGORY_LAST];
|
|
428
|
56
|
|
|
57 /* Table of all coding categories in decreasing order of priority.
|
|
|
58 This describes a permutation of the possible coding categories. */
|
|
448
|
59 int coding_category_by_priority[CODING_CATEGORY_LAST];
|
|
428
|
60
|
|
440
|
61 #ifdef MULE
|
|
428
|
62 Lisp_Object ucs_to_mule_table[65536];
|
|
440
|
63 #endif
|
|
428
|
64 } *fcd;
|
|
|
65
|
|
|
66 static const struct lrecord_description fcd_description_1[] = {
|
|
448
|
67 { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, coding_category_system), CODING_CATEGORY_LAST },
|
|
440
|
68 #ifdef MULE
|
|
442
|
69 { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, ucs_to_mule_table), countof (fcd->ucs_to_mule_table) },
|
|
440
|
70 #endif
|
|
428
|
71 { XD_END }
|
|
|
72 };
|
|
|
73
|
|
|
74 static const struct struct_description fcd_description = {
|
|
440
|
75 sizeof (struct file_coding_dump),
|
|
428
|
76 fcd_description_1
|
|
|
77 };
|
|
|
78
|
|
|
79 Lisp_Object mule_to_ucs_table;
|
|
|
80
|
|
|
81 Lisp_Object Qcoding_systemp;
|
|
|
82
|
|
|
83 Lisp_Object Qraw_text, Qno_conversion, Qccl, Qiso2022;
|
|
|
84 /* Qinternal in general.c */
|
|
|
85
|
|
|
86 Lisp_Object Qmnemonic, Qeol_type;
|
|
|
87 Lisp_Object Qcr, Qcrlf, Qlf;
|
|
|
88 Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf;
|
|
|
89 Lisp_Object Qpost_read_conversion;
|
|
|
90 Lisp_Object Qpre_write_conversion;
|
|
|
91
|
|
|
92 #ifdef MULE
|
|
|
93 Lisp_Object Qucs4, Qutf8;
|
|
|
94 Lisp_Object Qbig5, Qshift_jis;
|
|
|
95 Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3;
|
|
|
96 Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output;
|
|
|
97 Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output;
|
|
|
98 Lisp_Object Qno_iso6429;
|
|
|
99 Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion;
|
|
440
|
100 Lisp_Object Qescape_quoted;
|
|
428
|
101 Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift;
|
|
|
102 #endif
|
|
|
103 Lisp_Object Qencode, Qdecode;
|
|
|
104
|
|
|
105 Lisp_Object Vcoding_system_hash_table;
|
|
|
106
|
|
|
107 int enable_multibyte_characters;
|
|
|
108
|
|
|
109 #ifdef MULE
|
|
|
110 /* Additional information used by the ISO2022 decoder and detector. */
|
|
|
111 struct iso2022_decoder
|
|
|
112 {
|
|
|
113 /* CHARSET holds the character sets currently assigned to the G0
|
|
|
114 through G3 variables. It is initialized from the array
|
|
|
115 INITIAL_CHARSET in CODESYS. */
|
|
|
116 Lisp_Object charset[4];
|
|
|
117
|
|
|
118 /* Which registers are currently invoked into the left (GL) and
|
|
|
119 right (GR) halves of the 8-bit encoding space? */
|
|
|
120 int register_left, register_right;
|
|
|
121
|
|
|
122 /* ISO_ESC holds a value indicating part of an escape sequence
|
|
|
123 that has already been seen. */
|
|
|
124 enum iso_esc_flag esc;
|
|
|
125
|
|
|
126 /* This records the bytes we've seen so far in an escape sequence,
|
|
|
127 in case the sequence is invalid (we spit out the bytes unchanged). */
|
|
|
128 unsigned char esc_bytes[8];
|
|
|
129
|
|
|
130 /* Index for next byte to store in ISO escape sequence. */
|
|
|
131 int esc_bytes_index;
|
|
|
132
|
|
|
133 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
134 /* Stuff seen so far when composing a string. */
|
|
|
135 unsigned_char_dynarr *composite_chars;
|
|
|
136 #endif
|
|
|
137
|
|
|
138 /* If we saw an invalid designation sequence for a particular
|
|
|
139 register, we flag it here and switch to ASCII. The next time we
|
|
|
140 see a valid designation for this register, we turn off the flag
|
|
|
141 and do the designation normally, but pretend the sequence was
|
|
|
142 invalid. The effect of all this is that (most of the time) the
|
|
|
143 escape sequences for both the switch to the unknown charset, and
|
|
|
144 the switch back to the known charset, get inserted literally into
|
|
|
145 the buffer and saved out as such. The hope is that we can
|
|
|
146 preserve the escape sequences so that the resulting written out
|
|
|
147 file makes sense. If we don't do any of this, the designation
|
|
|
148 to the invalid charset will be preserved but that switch back
|
|
|
149 to the known charset will probably get eaten because it was
|
|
|
150 the same charset that was already present in the register. */
|
|
|
151 unsigned char invalid_designated[4];
|
|
|
152
|
|
|
153 /* We try to do similar things as above for direction-switching
|
|
|
154 sequences. If we encountered a direction switch while an
|
|
|
155 invalid designation was present, or an invalid designation
|
|
|
156 just after a direction switch (i.e. no valid designation
|
|
|
157 encountered yet), we insert the direction-switch escape
|
|
|
158 sequence literally into the output stream, and later on
|
|
|
159 insert the corresponding direction-restoring escape sequence
|
|
|
160 literally also. */
|
|
|
161 unsigned int switched_dir_and_no_valid_charset_yet :1;
|
|
|
162 unsigned int invalid_switch_dir :1;
|
|
|
163
|
|
|
164 /* Tells the decoder to output the escape sequence literally
|
|
|
165 even though it was valid. Used in the games we play to
|
|
|
166 avoid lossage when we encounter invalid designations. */
|
|
|
167 unsigned int output_literally :1;
|
|
|
168 /* We encountered a direction switch followed by an invalid
|
|
|
169 designation. We didn't output the direction switch
|
|
|
170 literally because we didn't know about the invalid designation;
|
|
|
171 but we have to do so now. */
|
|
|
172 unsigned int output_direction_sequence :1;
|
|
|
173 };
|
|
|
174 #endif /* MULE */
|
|
|
175 EXFUN (Fcopy_coding_system, 2);
|
|
|
176 #ifdef MULE
|
|
|
177 struct detection_state;
|
|
|
178 static int detect_coding_sjis (struct detection_state *st,
|
|
462
|
179 const Extbyte *src, Lstream_data_count n);
|
|
444
|
180 static void decode_coding_sjis (Lstream *decoding, const Extbyte *src,
|
|
462
|
181 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
182 static void encode_coding_sjis (Lstream *encoding, const Bufbyte *src,
|
|
462
|
183 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
184 static int detect_coding_big5 (struct detection_state *st,
|
|
462
|
185 const Extbyte *src, Lstream_data_count n);
|
|
444
|
186 static void decode_coding_big5 (Lstream *decoding, const Extbyte *src,
|
|
462
|
187 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
188 static void encode_coding_big5 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
189 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
190 static int detect_coding_ucs4 (struct detection_state *st,
|
|
462
|
191 const Extbyte *src, Lstream_data_count n);
|
|
444
|
192 static void decode_coding_ucs4 (Lstream *decoding, const Extbyte *src,
|
|
462
|
193 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
194 static void encode_coding_ucs4 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
195 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
196 static int detect_coding_utf8 (struct detection_state *st,
|
|
462
|
197 const Extbyte *src, Lstream_data_count n);
|
|
444
|
198 static void decode_coding_utf8 (Lstream *decoding, const Extbyte *src,
|
|
462
|
199 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
200 static void encode_coding_utf8 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
201 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
202 static int postprocess_iso2022_mask (int mask);
|
|
|
203 static void reset_iso2022 (Lisp_Object coding_system,
|
|
|
204 struct iso2022_decoder *iso);
|
|
|
205 static int detect_coding_iso2022 (struct detection_state *st,
|
|
462
|
206 const Extbyte *src, Lstream_data_count n);
|
|
444
|
207 static void decode_coding_iso2022 (Lstream *decoding, const Extbyte *src,
|
|
462
|
208 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
209 static void encode_coding_iso2022 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
210 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
211 #endif /* MULE */
|
|
444
|
212 static void decode_coding_no_conversion (Lstream *decoding, const Extbyte *src,
|
|
462
|
213 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
214 static void encode_coding_no_conversion (Lstream *encoding, const Bufbyte *src,
|
|
462
|
215 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
216 static void mule_decode (Lstream *decoding, const Extbyte *src,
|
|
462
|
217 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
444
|
218 static void mule_encode (Lstream *encoding, const Bufbyte *src,
|
|
462
|
219 unsigned_char_dynarr *dst, Lstream_data_count n);
|
|
428
|
220
|
|
|
221 typedef struct codesys_prop codesys_prop;
|
|
|
222 struct codesys_prop
|
|
|
223 {
|
|
|
224 Lisp_Object sym;
|
|
|
225 int prop_type;
|
|
|
226 };
|
|
|
227
|
|
|
228 typedef struct
|
|
|
229 {
|
|
|
230 Dynarr_declare (codesys_prop);
|
|
|
231 } codesys_prop_dynarr;
|
|
|
232
|
|
|
233 static const struct lrecord_description codesys_prop_description_1[] = {
|
|
440
|
234 { XD_LISP_OBJECT, offsetof (codesys_prop, sym) },
|
|
428
|
235 { XD_END }
|
|
|
236 };
|
|
|
237
|
|
|
238 static const struct struct_description codesys_prop_description = {
|
|
440
|
239 sizeof (codesys_prop),
|
|
428
|
240 codesys_prop_description_1
|
|
|
241 };
|
|
|
242
|
|
|
243 static const struct lrecord_description codesys_prop_dynarr_description_1[] = {
|
|
440
|
244 XD_DYNARR_DESC (codesys_prop_dynarr, &codesys_prop_description),
|
|
428
|
245 { XD_END }
|
|
|
246 };
|
|
|
247
|
|
|
248 static const struct struct_description codesys_prop_dynarr_description = {
|
|
440
|
249 sizeof (codesys_prop_dynarr),
|
|
428
|
250 codesys_prop_dynarr_description_1
|
|
|
251 };
|
|
|
252
|
|
|
253 codesys_prop_dynarr *the_codesys_prop_dynarr;
|
|
|
254
|
|
|
255 enum codesys_prop_enum
|
|
|
256 {
|
|
|
257 CODESYS_PROP_ALL_OK,
|
|
|
258 CODESYS_PROP_ISO2022,
|
|
|
259 CODESYS_PROP_CCL
|
|
|
260 };
|
|
|
261
|
|
|
262
|
|
|
263 /************************************************************************/
|
|
|
264 /* Coding system functions */
|
|
|
265 /************************************************************************/
|
|
|
266
|
|
|
267 static Lisp_Object mark_coding_system (Lisp_Object);
|
|
|
268 static void print_coding_system (Lisp_Object, Lisp_Object, int);
|
|
|
269 static void finalize_coding_system (void *header, int for_disksave);
|
|
|
270
|
|
|
271 #ifdef MULE
|
|
|
272 static const struct lrecord_description ccs_description_1[] = {
|
|
440
|
273 { XD_LISP_OBJECT, offsetof (charset_conversion_spec, from_charset) },
|
|
|
274 { XD_LISP_OBJECT, offsetof (charset_conversion_spec, to_charset) },
|
|
428
|
275 { XD_END }
|
|
|
276 };
|
|
|
277
|
|
|
278 static const struct struct_description ccs_description = {
|
|
440
|
279 sizeof (charset_conversion_spec),
|
|
428
|
280 ccs_description_1
|
|
|
281 };
|
|
|
282
|
|
|
283 static const struct lrecord_description ccsd_description_1[] = {
|
|
440
|
284 XD_DYNARR_DESC (charset_conversion_spec_dynarr, &ccs_description),
|
|
428
|
285 { XD_END }
|
|
|
286 };
|
|
|
287
|
|
|
288 static const struct struct_description ccsd_description = {
|
|
440
|
289 sizeof (charset_conversion_spec_dynarr),
|
|
428
|
290 ccsd_description_1
|
|
|
291 };
|
|
|
292 #endif
|
|
|
293
|
|
|
294 static const struct lrecord_description coding_system_description[] = {
|
|
440
|
295 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, name) },
|
|
|
296 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, doc_string) },
|
|
|
297 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, mnemonic) },
|
|
|
298 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, post_read_conversion) },
|
|
|
299 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, pre_write_conversion) },
|
|
|
300 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_lf) },
|
|
|
301 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_crlf) },
|
|
|
302 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_cr) },
|
|
428
|
303 #ifdef MULE
|
|
440
|
304 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Coding_System, iso2022.initial_charset), 4 },
|
|
|
305 { XD_STRUCT_PTR, offsetof (Lisp_Coding_System, iso2022.input_conv), 1, &ccsd_description },
|
|
|
306 { XD_STRUCT_PTR, offsetof (Lisp_Coding_System, iso2022.output_conv), 1, &ccsd_description },
|
|
|
307 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.decode) },
|
|
|
308 { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.encode) },
|
|
428
|
309 #endif
|
|
|
310 { XD_END }
|
|
|
311 };
|
|
|
312
|
|
|
313 DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system,
|
|
|
314 mark_coding_system, print_coding_system,
|
|
|
315 finalize_coding_system,
|
|
|
316 0, 0, coding_system_description,
|
|
440
|
317 Lisp_Coding_System);
|
|
428
|
318
|
|
|
319 static Lisp_Object
|
|
|
320 mark_coding_system (Lisp_Object obj)
|
|
|
321 {
|
|
|
322 Lisp_Coding_System *codesys = XCODING_SYSTEM (obj);
|
|
|
323
|
|
|
324 mark_object (CODING_SYSTEM_NAME (codesys));
|
|
|
325 mark_object (CODING_SYSTEM_DOC_STRING (codesys));
|
|
|
326 mark_object (CODING_SYSTEM_MNEMONIC (codesys));
|
|
|
327 mark_object (CODING_SYSTEM_EOL_LF (codesys));
|
|
|
328 mark_object (CODING_SYSTEM_EOL_CRLF (codesys));
|
|
|
329 mark_object (CODING_SYSTEM_EOL_CR (codesys));
|
|
|
330
|
|
|
331 switch (CODING_SYSTEM_TYPE (codesys))
|
|
|
332 {
|
|
|
333 #ifdef MULE
|
|
|
334 int i;
|
|
|
335 case CODESYS_ISO2022:
|
|
|
336 for (i = 0; i < 4; i++)
|
|
|
337 mark_object (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i));
|
|
|
338 if (codesys->iso2022.input_conv)
|
|
|
339 {
|
|
|
340 for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++)
|
|
|
341 {
|
|
|
342 struct charset_conversion_spec *ccs =
|
|
|
343 Dynarr_atp (codesys->iso2022.input_conv, i);
|
|
|
344 mark_object (ccs->from_charset);
|
|
|
345 mark_object (ccs->to_charset);
|
|
|
346 }
|
|
|
347 }
|
|
|
348 if (codesys->iso2022.output_conv)
|
|
|
349 {
|
|
|
350 for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++)
|
|
|
351 {
|
|
|
352 struct charset_conversion_spec *ccs =
|
|
|
353 Dynarr_atp (codesys->iso2022.output_conv, i);
|
|
|
354 mark_object (ccs->from_charset);
|
|
|
355 mark_object (ccs->to_charset);
|
|
|
356 }
|
|
|
357 }
|
|
|
358 break;
|
|
|
359
|
|
|
360 case CODESYS_CCL:
|
|
|
361 mark_object (CODING_SYSTEM_CCL_DECODE (codesys));
|
|
|
362 mark_object (CODING_SYSTEM_CCL_ENCODE (codesys));
|
|
|
363 break;
|
|
|
364 #endif /* MULE */
|
|
|
365 default:
|
|
|
366 break;
|
|
|
367 }
|
|
|
368
|
|
|
369 mark_object (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys));
|
|
|
370 return CODING_SYSTEM_POST_READ_CONVERSION (codesys);
|
|
|
371 }
|
|
|
372
|
|
|
373 static void
|
|
|
374 print_coding_system (Lisp_Object obj, Lisp_Object printcharfun,
|
|
|
375 int escapeflag)
|
|
|
376 {
|
|
|
377 Lisp_Coding_System *c = XCODING_SYSTEM (obj);
|
|
|
378 if (print_readably)
|
|
563
|
379 printing_unreadable_object ("#<coding_system 0x%x>", c->header.uid);
|
|
428
|
380
|
|
|
381 write_c_string ("#<coding_system ", printcharfun);
|
|
|
382 print_internal (c->name, printcharfun, 1);
|
|
|
383 write_c_string (">", printcharfun);
|
|
|
384 }
|
|
|
385
|
|
|
386 static void
|
|
|
387 finalize_coding_system (void *header, int for_disksave)
|
|
|
388 {
|
|
|
389 Lisp_Coding_System *c = (Lisp_Coding_System *) header;
|
|
|
390 /* Since coding systems never go away, this function is not
|
|
|
391 necessary. But it would be necessary if we changed things
|
|
|
392 so that coding systems could go away. */
|
|
|
393 if (!for_disksave) /* see comment in lstream.c */
|
|
|
394 {
|
|
|
395 switch (CODING_SYSTEM_TYPE (c))
|
|
|
396 {
|
|
|
397 #ifdef MULE
|
|
|
398 case CODESYS_ISO2022:
|
|
|
399 if (c->iso2022.input_conv)
|
|
|
400 {
|
|
|
401 Dynarr_free (c->iso2022.input_conv);
|
|
|
402 c->iso2022.input_conv = 0;
|
|
|
403 }
|
|
|
404 if (c->iso2022.output_conv)
|
|
|
405 {
|
|
|
406 Dynarr_free (c->iso2022.output_conv);
|
|
|
407 c->iso2022.output_conv = 0;
|
|
|
408 }
|
|
|
409 break;
|
|
|
410 #endif /* MULE */
|
|
|
411 default:
|
|
|
412 break;
|
|
|
413 }
|
|
|
414 }
|
|
|
415 }
|
|
|
416
|
|
438
|
417 static eol_type_t
|
|
428
|
418 symbol_to_eol_type (Lisp_Object symbol)
|
|
|
419 {
|
|
|
420 CHECK_SYMBOL (symbol);
|
|
|
421 if (NILP (symbol)) return EOL_AUTODETECT;
|
|
|
422 if (EQ (symbol, Qlf)) return EOL_LF;
|
|
|
423 if (EQ (symbol, Qcrlf)) return EOL_CRLF;
|
|
|
424 if (EQ (symbol, Qcr)) return EOL_CR;
|
|
|
425
|
|
563
|
426 invalid_constant ("Unrecognized eol type", symbol);
|
|
428
|
427 return EOL_AUTODETECT; /* not reached */
|
|
|
428 }
|
|
|
429
|
|
|
430 static Lisp_Object
|
|
438
|
431 eol_type_to_symbol (eol_type_t type)
|
|
428
|
432 {
|
|
|
433 switch (type)
|
|
|
434 {
|
|
|
435 default: abort ();
|
|
|
436 case EOL_LF: return Qlf;
|
|
|
437 case EOL_CRLF: return Qcrlf;
|
|
|
438 case EOL_CR: return Qcr;
|
|
|
439 case EOL_AUTODETECT: return Qnil;
|
|
|
440 }
|
|
|
441 }
|
|
|
442
|
|
|
443 static void
|
|
|
444 setup_eol_coding_systems (Lisp_Coding_System *codesys)
|
|
|
445 {
|
|
|
446 Lisp_Object codesys_obj;
|
|
|
447 int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name);
|
|
|
448 char *codesys_name = (char *) alloca (len + 7);
|
|
|
449 int mlen = -1;
|
|
|
450 char *codesys_mnemonic=0;
|
|
|
451
|
|
|
452 Lisp_Object codesys_name_sym, sub_codesys_obj;
|
|
|
453
|
|
|
454 /* kludge */
|
|
|
455
|
|
|
456 XSETCODING_SYSTEM (codesys_obj, codesys);
|
|
|
457
|
|
|
458 memcpy (codesys_name,
|
|
|
459 string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len);
|
|
|
460
|
|
|
461 if (STRINGP (CODING_SYSTEM_MNEMONIC (codesys)))
|
|
|
462 {
|
|
|
463 mlen = XSTRING_LENGTH (CODING_SYSTEM_MNEMONIC (codesys));
|
|
|
464 codesys_mnemonic = (char *) alloca (mlen + 7);
|
|
|
465 memcpy (codesys_mnemonic,
|
|
|
466 XSTRING_DATA (CODING_SYSTEM_MNEMONIC (codesys)), mlen);
|
|
|
467 }
|
|
|
468
|
|
|
469 #define DEFINE_SUB_CODESYS(op_sys, op_sys_abbr, Type) do { \
|
|
|
470 strcpy (codesys_name + len, "-" op_sys); \
|
|
|
471 if (mlen != -1) \
|
|
|
472 strcpy (codesys_mnemonic + mlen, op_sys_abbr); \
|
|
|
473 codesys_name_sym = intern (codesys_name); \
|
|
|
474 sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym); \
|
|
|
475 XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type; \
|
|
|
476 if (mlen != -1) \
|
|
|
477 XCODING_SYSTEM_MNEMONIC(sub_codesys_obj) = \
|
|
|
478 build_string (codesys_mnemonic); \
|
|
|
479 CODING_SYSTEM_##Type (codesys) = sub_codesys_obj; \
|
|
|
480 } while (0)
|
|
|
481
|
|
|
482 DEFINE_SUB_CODESYS("unix", "", EOL_LF);
|
|
|
483 DEFINE_SUB_CODESYS("dos", ":T", EOL_CRLF);
|
|
|
484 DEFINE_SUB_CODESYS("mac", ":t", EOL_CR);
|
|
|
485 }
|
|
|
486
|
|
|
487 DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /*
|
|
|
488 Return t if OBJECT is a coding system.
|
|
|
489 A coding system is an object that defines how text containing multiple
|
|
|
490 character sets is encoded into a stream of (typically 8-bit) bytes.
|
|
|
491 The coding system is used to decode the stream into a series of
|
|
|
492 characters (which may be from multiple charsets) when the text is read
|
|
|
493 from a file or process, and is used to encode the text back into the
|
|
|
494 same format when it is written out to a file or process.
|
|
|
495
|
|
|
496 For example, many ISO2022-compliant coding systems (such as Compound
|
|
|
497 Text, which is used for inter-client data under the X Window System)
|
|
|
498 use escape sequences to switch between different charsets -- Japanese
|
|
|
499 Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked
|
|
|
500 with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See
|
|
|
501 `make-coding-system' for more information.
|
|
|
502
|
|
|
503 Coding systems are normally identified using a symbol, and the
|
|
|
504 symbol is accepted in place of the actual coding system object whenever
|
|
|
505 a coding system is called for. (This is similar to how faces work.)
|
|
|
506 */
|
|
|
507 (object))
|
|
|
508 {
|
|
|
509 return CODING_SYSTEMP (object) ? Qt : Qnil;
|
|
|
510 }
|
|
|
511
|
|
|
512 DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /*
|
|
|
513 Retrieve the coding system of the given name.
|
|
|
514
|
|
|
515 If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply
|
|
|
516 returned. Otherwise, CODING-SYSTEM-OR-NAME should be a symbol.
|
|
|
517 If there is no such coding system, nil is returned. Otherwise the
|
|
|
518 associated coding system object is returned.
|
|
|
519 */
|
|
|
520 (coding_system_or_name))
|
|
|
521 {
|
|
|
522 if (NILP (coding_system_or_name))
|
|
|
523 coding_system_or_name = Qbinary;
|
|
440
|
524 else if (CODING_SYSTEMP (coding_system_or_name))
|
|
|
525 return coding_system_or_name;
|
|
428
|
526 else
|
|
|
527 CHECK_SYMBOL (coding_system_or_name);
|
|
|
528
|
|
440
|
529 while (1)
|
|
|
530 {
|
|
|
531 coding_system_or_name =
|
|
|
532 Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil);
|
|
|
533
|
|
|
534 if (CODING_SYSTEMP (coding_system_or_name) || NILP (coding_system_or_name))
|
|
|
535 return coding_system_or_name;
|
|
|
536 }
|
|
428
|
537 }
|
|
|
538
|
|
|
539 DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /*
|
|
|
540 Retrieve the coding system of the given name.
|
|
|
541 Same as `find-coding-system' except that if there is no such
|
|
|
542 coding system, an error is signaled instead of returning nil.
|
|
|
543 */
|
|
|
544 (name))
|
|
|
545 {
|
|
|
546 Lisp_Object coding_system = Ffind_coding_system (name);
|
|
|
547
|
|
|
548 if (NILP (coding_system))
|
|
563
|
549 invalid_argument ("No such coding system", name);
|
|
428
|
550 return coding_system;
|
|
|
551 }
|
|
|
552
|
|
|
553 /* We store the coding systems in hash tables with the names as the key and the
|
|
|
554 actual coding system object as the value. Occasionally we need to use them
|
|
|
555 in a list format. These routines provide us with that. */
|
|
|
556 struct coding_system_list_closure
|
|
|
557 {
|
|
|
558 Lisp_Object *coding_system_list;
|
|
|
559 };
|
|
|
560
|
|
|
561 static int
|
|
|
562 add_coding_system_to_list_mapper (Lisp_Object key, Lisp_Object value,
|
|
|
563 void *coding_system_list_closure)
|
|
|
564 {
|
|
|
565 /* This function can GC */
|
|
|
566 struct coding_system_list_closure *cscl =
|
|
|
567 (struct coding_system_list_closure *) coding_system_list_closure;
|
|
|
568 Lisp_Object *coding_system_list = cscl->coding_system_list;
|
|
|
569
|
|
432
|
570 *coding_system_list = Fcons (key, *coding_system_list);
|
|
428
|
571 return 0;
|
|
|
572 }
|
|
|
573
|
|
|
574 DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /*
|
|
|
575 Return a list of the names of all defined coding systems.
|
|
|
576 */
|
|
|
577 ())
|
|
|
578 {
|
|
|
579 Lisp_Object coding_system_list = Qnil;
|
|
|
580 struct gcpro gcpro1;
|
|
|
581 struct coding_system_list_closure coding_system_list_closure;
|
|
|
582
|
|
|
583 GCPRO1 (coding_system_list);
|
|
|
584 coding_system_list_closure.coding_system_list = &coding_system_list;
|
|
|
585 elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table,
|
|
|
586 &coding_system_list_closure);
|
|
|
587 UNGCPRO;
|
|
|
588
|
|
|
589 return coding_system_list;
|
|
|
590 }
|
|
|
591
|
|
|
592 DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /*
|
|
|
593 Return the name of the given coding system.
|
|
|
594 */
|
|
|
595 (coding_system))
|
|
|
596 {
|
|
|
597 coding_system = Fget_coding_system (coding_system);
|
|
|
598 return XCODING_SYSTEM_NAME (coding_system);
|
|
|
599 }
|
|
|
600
|
|
|
601 static Lisp_Coding_System *
|
|
|
602 allocate_coding_system (enum coding_system_type type, Lisp_Object name)
|
|
|
603 {
|
|
|
604 Lisp_Coding_System *codesys =
|
|
|
605 alloc_lcrecord_type (Lisp_Coding_System, &lrecord_coding_system);
|
|
|
606
|
|
|
607 zero_lcrecord (codesys);
|
|
|
608 CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil;
|
|
|
609 CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil;
|
|
|
610 CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT;
|
|
|
611 CODING_SYSTEM_EOL_CRLF (codesys) = Qnil;
|
|
|
612 CODING_SYSTEM_EOL_CR (codesys) = Qnil;
|
|
|
613 CODING_SYSTEM_EOL_LF (codesys) = Qnil;
|
|
|
614 CODING_SYSTEM_TYPE (codesys) = type;
|
|
|
615 CODING_SYSTEM_MNEMONIC (codesys) = Qnil;
|
|
|
616 #ifdef MULE
|
|
|
617 if (type == CODESYS_ISO2022)
|
|
|
618 {
|
|
|
619 int i;
|
|
|
620 for (i = 0; i < 4; i++)
|
|
|
621 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil;
|
|
|
622 }
|
|
|
623 else if (type == CODESYS_CCL)
|
|
|
624 {
|
|
|
625 CODING_SYSTEM_CCL_DECODE (codesys) = Qnil;
|
|
|
626 CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil;
|
|
|
627 }
|
|
|
628 #endif /* MULE */
|
|
|
629 CODING_SYSTEM_NAME (codesys) = name;
|
|
|
630
|
|
|
631 return codesys;
|
|
|
632 }
|
|
|
633
|
|
|
634 #ifdef MULE
|
|
|
635 /* Given a list of charset conversion specs as specified in a Lisp
|
|
|
636 program, parse it into STORE_HERE. */
|
|
|
637
|
|
|
638 static void
|
|
|
639 parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here,
|
|
|
640 Lisp_Object spec_list)
|
|
|
641 {
|
|
|
642 Lisp_Object rest;
|
|
|
643
|
|
|
644 EXTERNAL_LIST_LOOP (rest, spec_list)
|
|
|
645 {
|
|
|
646 Lisp_Object car = XCAR (rest);
|
|
|
647 Lisp_Object from, to;
|
|
|
648 struct charset_conversion_spec spec;
|
|
|
649
|
|
|
650 if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car))))
|
|
563
|
651 invalid_argument ("Invalid charset conversion spec", car);
|
|
428
|
652 from = Fget_charset (XCAR (car));
|
|
|
653 to = Fget_charset (XCAR (XCDR (car)));
|
|
|
654 if (XCHARSET_TYPE (from) != XCHARSET_TYPE (to))
|
|
563
|
655 invalid_operation_2
|
|
428
|
656 ("Attempted conversion between different charset types",
|
|
|
657 from, to);
|
|
|
658 spec.from_charset = from;
|
|
|
659 spec.to_charset = to;
|
|
|
660
|
|
|
661 Dynarr_add (store_here, spec);
|
|
|
662 }
|
|
|
663 }
|
|
|
664
|
|
|
665 /* Given a dynarr LOAD_HERE of internally-stored charset conversion
|
|
|
666 specs, return the equivalent as the Lisp programmer would see it.
|
|
|
667
|
|
|
668 If LOAD_HERE is 0, return Qnil. */
|
|
|
669
|
|
|
670 static Lisp_Object
|
|
|
671 unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here)
|
|
|
672 {
|
|
|
673 int i;
|
|
|
674 Lisp_Object result;
|
|
|
675
|
|
|
676 if (!load_here)
|
|
|
677 return Qnil;
|
|
|
678 for (i = 0, result = Qnil; i < Dynarr_length (load_here); i++)
|
|
|
679 {
|
|
|
680 struct charset_conversion_spec *ccs = Dynarr_atp (load_here, i);
|
|
|
681 result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result);
|
|
|
682 }
|
|
|
683
|
|
|
684 return Fnreverse (result);
|
|
|
685 }
|
|
|
686
|
|
|
687 #endif /* MULE */
|
|
|
688
|
|
|
689 DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /*
|
|
|
690 Register symbol NAME as a coding system.
|
|
|
691
|
|
|
692 TYPE describes the conversion method used and should be one of
|
|
|
693
|
|
|
694 nil or 'undecided
|
|
|
695 Automatic conversion. XEmacs attempts to detect the coding system
|
|
|
696 used in the file.
|
|
|
697 'no-conversion
|
|
|
698 No conversion. Use this for binary files and such. On output,
|
|
|
699 graphic characters that are not in ASCII or Latin-1 will be
|
|
|
700 replaced by a ?. (For a no-conversion-encoded buffer, these
|
|
|
701 characters will only be present if you explicitly insert them.)
|
|
|
702 'shift-jis
|
|
|
703 Shift-JIS (a Japanese encoding commonly used in PC operating systems).
|
|
|
704 'ucs-4
|
|
|
705 ISO 10646 UCS-4 encoding.
|
|
|
706 'utf-8
|
|
|
707 ISO 10646 UTF-8 encoding.
|
|
|
708 'iso2022
|
|
|
709 Any ISO2022-compliant encoding. Among other things, this includes
|
|
|
710 JIS (the Japanese encoding commonly used for e-mail), EUC (the
|
|
|
711 standard Unix encoding for Japanese and other languages), and
|
|
|
712 Compound Text (the encoding used in X11). You can specify more
|
|
442
|
713 specific information about the conversion with the PROPS argument.
|
|
428
|
714 'big5
|
|
|
715 Big5 (the encoding commonly used for Taiwanese).
|
|
|
716 'ccl
|
|
|
717 The conversion is performed using a user-written pseudo-code
|
|
|
718 program. CCL (Code Conversion Language) is the name of this
|
|
|
719 pseudo-code.
|
|
|
720 'internal
|
|
|
721 Write out or read in the raw contents of the memory representing
|
|
|
722 the buffer's text. This is primarily useful for debugging
|
|
|
723 purposes, and is only enabled when XEmacs has been compiled with
|
|
|
724 DEBUG_XEMACS defined (via the --debug configure option).
|
|
|
725 WARNING: Reading in a file using 'internal conversion can result
|
|
|
726 in an internal inconsistency in the memory representing a
|
|
|
727 buffer's text, which will produce unpredictable results and may
|
|
|
728 cause XEmacs to crash. Under normal circumstances you should
|
|
|
729 never use 'internal conversion.
|
|
|
730
|
|
|
731 DOC-STRING is a string describing the coding system.
|
|
|
732
|
|
|
733 PROPS is a property list, describing the specific nature of the
|
|
|
734 character set. Recognized properties are:
|
|
|
735
|
|
|
736 'mnemonic
|
|
|
737 String to be displayed in the modeline when this coding system is
|
|
|
738 active.
|
|
|
739
|
|
|
740 'eol-type
|
|
|
741 End-of-line conversion to be used. It should be one of
|
|
|
742
|
|
|
743 nil
|
|
|
744 Automatically detect the end-of-line type (LF, CRLF,
|
|
|
745 or CR). Also generate subsidiary coding systems named
|
|
|
746 `NAME-unix', `NAME-dos', and `NAME-mac', that are
|
|
|
747 identical to this coding system but have an EOL-TYPE
|
|
|
748 value of 'lf, 'crlf, and 'cr, respectively.
|
|
|
749 'lf
|
|
|
750 The end of a line is marked externally using ASCII LF.
|
|
|
751 Since this is also the way that XEmacs represents an
|
|
|
752 end-of-line internally, specifying this option results
|
|
|
753 in no end-of-line conversion. This is the standard
|
|
|
754 format for Unix text files.
|
|
|
755 'crlf
|
|
|
756 The end of a line is marked externally using ASCII
|
|
|
757 CRLF. This is the standard format for MS-DOS text
|
|
|
758 files.
|
|
|
759 'cr
|
|
|
760 The end of a line is marked externally using ASCII CR.
|
|
|
761 This is the standard format for Macintosh text files.
|
|
|
762 t
|
|
|
763 Automatically detect the end-of-line type but do not
|
|
|
764 generate subsidiary coding systems. (This value is
|
|
|
765 converted to nil when stored internally, and
|
|
|
766 `coding-system-property' will return nil.)
|
|
|
767
|
|
|
768 'post-read-conversion
|
|
|
769 Function called after a file has been read in, to perform the
|
|
444
|
770 decoding. Called with two arguments, START and END, denoting
|
|
428
|
771 a region of the current buffer to be decoded.
|
|
|
772
|
|
|
773 'pre-write-conversion
|
|
|
774 Function called before a file is written out, to perform the
|
|
444
|
775 encoding. Called with two arguments, START and END, denoting
|
|
428
|
776 a region of the current buffer to be encoded.
|
|
|
777
|
|
|
778
|
|
|
779 The following additional properties are recognized if TYPE is 'iso2022:
|
|
|
780
|
|
|
781 'charset-g0
|
|
|
782 'charset-g1
|
|
|
783 'charset-g2
|
|
|
784 'charset-g3
|
|
|
785 The character set initially designated to the G0 - G3 registers.
|
|
|
786 The value should be one of
|
|
|
787
|
|
|
788 -- A charset object (designate that character set)
|
|
|
789 -- nil (do not ever use this register)
|
|
|
790 -- t (no character set is initially designated to
|
|
|
791 the register, but may be later on; this automatically
|
|
|
792 sets the corresponding `force-g*-on-output' property)
|
|
|
793
|
|
|
794 'force-g0-on-output
|
|
|
795 'force-g1-on-output
|
|
|
796 'force-g2-on-output
|
|
|
797 'force-g2-on-output
|
|
|
798 If non-nil, send an explicit designation sequence on output before
|
|
|
799 using the specified register.
|
|
|
800
|
|
|
801 'short
|
|
|
802 If non-nil, use the short forms "ESC $ @", "ESC $ A", and
|
|
|
803 "ESC $ B" on output in place of the full designation sequences
|
|
|
804 "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B".
|
|
|
805
|
|
|
806 'no-ascii-eol
|
|
|
807 If non-nil, don't designate ASCII to G0 at each end of line on output.
|
|
|
808 Setting this to non-nil also suppresses other state-resetting that
|
|
|
809 normally happens at the end of a line.
|
|
|
810
|
|
|
811 'no-ascii-cntl
|
|
|
812 If non-nil, don't designate ASCII to G0 before control chars on output.
|
|
|
813
|
|
|
814 'seven
|
|
|
815 If non-nil, use 7-bit environment on output. Otherwise, use 8-bit
|
|
|
816 environment.
|
|
|
817
|
|
|
818 'lock-shift
|
|
|
819 If non-nil, use locking-shift (SO/SI) instead of single-shift
|
|
|
820 or designation by escape sequence.
|
|
|
821
|
|
|
822 'no-iso6429
|
|
|
823 If non-nil, don't use ISO6429's direction specification.
|
|
|
824
|
|
|
825 'escape-quoted
|
|
|
826 If non-nil, literal control characters that are the same as
|
|
|
827 the beginning of a recognized ISO2022 or ISO6429 escape sequence
|
|
|
828 (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E),
|
|
|
829 SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character
|
|
|
830 so that they can be properly distinguished from an escape sequence.
|
|
|
831 (Note that doing this results in a non-portable encoding.) This
|
|
|
832 encoding flag is used for byte-compiled files. Note that ESC
|
|
|
833 is a good choice for a quoting character because there are no
|
|
|
834 escape sequences whose second byte is a character from the Control-0
|
|
|
835 or Control-1 character sets; this is explicitly disallowed by the
|
|
|
836 ISO2022 standard.
|
|
|
837
|
|
|
838 'input-charset-conversion
|
|
|
839 A list of conversion specifications, specifying conversion of
|
|
|
840 characters in one charset to another when decoding is performed.
|
|
|
841 Each specification is a list of two elements: the source charset,
|
|
|
842 and the destination charset.
|
|
|
843
|
|
|
844 'output-charset-conversion
|
|
|
845 A list of conversion specifications, specifying conversion of
|
|
|
846 characters in one charset to another when encoding is performed.
|
|
|
847 The form of each specification is the same as for
|
|
|
848 'input-charset-conversion.
|
|
|
849
|
|
|
850
|
|
|
851 The following additional properties are recognized (and required)
|
|
|
852 if TYPE is 'ccl:
|
|
|
853
|
|
|
854 'decode
|
|
|
855 CCL program used for decoding (converting to internal format).
|
|
|
856
|
|
|
857 'encode
|
|
|
858 CCL program used for encoding (converting to external format).
|
|
|
859 */
|
|
|
860 (name, type, doc_string, props))
|
|
|
861 {
|
|
|
862 Lisp_Coding_System *codesys;
|
|
|
863 enum coding_system_type ty;
|
|
|
864 int need_to_setup_eol_systems = 1;
|
|
|
865
|
|
|
866 /* Convert type to constant */
|
|
|
867 if (NILP (type) || EQ (type, Qundecided))
|
|
|
868 { ty = CODESYS_AUTODETECT; }
|
|
|
869 #ifdef MULE
|
|
|
870 else if (EQ (type, Qshift_jis)) { ty = CODESYS_SHIFT_JIS; }
|
|
|
871 else if (EQ (type, Qiso2022)) { ty = CODESYS_ISO2022; }
|
|
|
872 else if (EQ (type, Qbig5)) { ty = CODESYS_BIG5; }
|
|
|
873 else if (EQ (type, Qucs4)) { ty = CODESYS_UCS4; }
|
|
|
874 else if (EQ (type, Qutf8)) { ty = CODESYS_UTF8; }
|
|
|
875 else if (EQ (type, Qccl)) { ty = CODESYS_CCL; }
|
|
|
876 #endif
|
|
|
877 else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; }
|
|
|
878 #ifdef DEBUG_XEMACS
|
|
|
879 else if (EQ (type, Qinternal)) { ty = CODESYS_INTERNAL; }
|
|
|
880 #endif
|
|
|
881 else
|
|
563
|
882 invalid_constant ("Invalid coding system type", type);
|
|
428
|
883
|
|
|
884 CHECK_SYMBOL (name);
|
|
|
885
|
|
|
886 codesys = allocate_coding_system (ty, name);
|
|
|
887
|
|
|
888 if (NILP (doc_string))
|
|
|
889 doc_string = build_string ("");
|
|
|
890 else
|
|
|
891 CHECK_STRING (doc_string);
|
|
|
892 CODING_SYSTEM_DOC_STRING (codesys) = doc_string;
|
|
|
893
|
|
442
|
894 {
|
|
|
895 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, props)
|
|
|
896 {
|
|
|
897 if (EQ (key, Qmnemonic))
|
|
|
898 {
|
|
|
899 if (!NILP (value))
|
|
|
900 CHECK_STRING (value);
|
|
|
901 CODING_SYSTEM_MNEMONIC (codesys) = value;
|
|
|
902 }
|
|
|
903
|
|
|
904 else if (EQ (key, Qeol_type))
|
|
|
905 {
|
|
|
906 need_to_setup_eol_systems = NILP (value);
|
|
|
907 if (EQ (value, Qt))
|
|
|
908 value = Qnil;
|
|
|
909 CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value);
|
|
|
910 }
|
|
|
911
|
|
|
912 else if (EQ (key, Qpost_read_conversion)) CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value;
|
|
|
913 else if (EQ (key, Qpre_write_conversion)) CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value;
|
|
428
|
914 #ifdef MULE
|
|
442
|
915 else if (ty == CODESYS_ISO2022)
|
|
|
916 {
|
|
428
|
917 #define FROB_INITIAL_CHARSET(charset_num) \
|
|
|
918 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \
|
|
|
919 ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value))
|
|
|
920
|
|
442
|
921 if (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
|
|
|
922 else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1);
|
|
|
923 else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2);
|
|
|
924 else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3);
|
|
428
|
925
|
|
|
926 #define FROB_FORCE_CHARSET(charset_num) \
|
|
|
927 CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value)
|
|
|
928
|
|
442
|
929 else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0);
|
|
|
930 else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1);
|
|
|
931 else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2);
|
|
|
932 else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3);
|
|
428
|
933
|
|
|
934 #define FROB_BOOLEAN_PROPERTY(prop) \
|
|
|
935 CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value)
|
|
|
936
|
|
442
|
937 else if (EQ (key, Qshort)) FROB_BOOLEAN_PROPERTY (SHORT);
|
|
|
938 else if (EQ (key, Qno_ascii_eol)) FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL);
|
|
|
939 else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL);
|
|
|
940 else if (EQ (key, Qseven)) FROB_BOOLEAN_PROPERTY (SEVEN);
|
|
|
941 else if (EQ (key, Qlock_shift)) FROB_BOOLEAN_PROPERTY (LOCK_SHIFT);
|
|
|
942 else if (EQ (key, Qno_iso6429)) FROB_BOOLEAN_PROPERTY (NO_ISO6429);
|
|
|
943 else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED);
|
|
|
944
|
|
|
945 else if (EQ (key, Qinput_charset_conversion))
|
|
|
946 {
|
|
|
947 codesys->iso2022.input_conv =
|
|
|
948 Dynarr_new (charset_conversion_spec);
|
|
|
949 parse_charset_conversion_specs (codesys->iso2022.input_conv,
|
|
|
950 value);
|
|
|
951 }
|
|
|
952 else if (EQ (key, Qoutput_charset_conversion))
|
|
|
953 {
|
|
|
954 codesys->iso2022.output_conv =
|
|
|
955 Dynarr_new (charset_conversion_spec);
|
|
|
956 parse_charset_conversion_specs (codesys->iso2022.output_conv,
|
|
|
957 value);
|
|
|
958 }
|
|
|
959 else
|
|
563
|
960 invalid_constant ("Unrecognized property", key);
|
|
442
|
961 }
|
|
|
962 else if (EQ (type, Qccl))
|
|
|
963 {
|
|
444
|
964 Lisp_Object sym;
|
|
|
965 struct ccl_program test_ccl;
|
|
|
966 Extbyte *suffix;
|
|
|
967
|
|
|
968 /* Check key first. */
|
|
442
|
969 if (EQ (key, Qdecode))
|
|
444
|
970 suffix = "-ccl-decode";
|
|
|
971 else if (EQ (key, Qencode))
|
|
|
972 suffix = "-ccl-encode";
|
|
|
973 else
|
|
563
|
974 invalid_constant ("Unrecognized property", key);
|
|
444
|
975
|
|
|
976 /* If value is vector, register it as a ccl program
|
|
|
977 associated with an newly created symbol for
|
|
|
978 backward compatibility. */
|
|
|
979 if (VECTORP (value))
|
|
442
|
980 {
|
|
444
|
981 sym = Fintern (concat2 (Fsymbol_name (name),
|
|
|
982 build_string (suffix)),
|
|
|
983 Qnil);
|
|
|
984 Fregister_ccl_program (sym, value);
|
|
442
|
985 }
|
|
|
986 else
|
|
444
|
987 {
|
|
|
988 CHECK_SYMBOL (value);
|
|
|
989 sym = value;
|
|
|
990 }
|
|
|
991 /* check if the given ccl programs are valid. */
|
|
|
992 if (setup_ccl_program (&test_ccl, sym) < 0)
|
|
563
|
993 invalid_argument ("Invalid CCL program", value);
|
|
444
|
994
|
|
|
995 if (EQ (key, Qdecode))
|
|
|
996 CODING_SYSTEM_CCL_DECODE (codesys) = sym;
|
|
|
997 else if (EQ (key, Qencode))
|
|
|
998 CODING_SYSTEM_CCL_ENCODE (codesys) = sym;
|
|
|
999
|
|
442
|
1000 }
|
|
428
|
1001 #endif /* MULE */
|
|
442
|
1002 else
|
|
563
|
1003 invalid_constant ("Unrecognized property", key);
|
|
442
|
1004 }
|
|
|
1005 }
|
|
428
|
1006
|
|
|
1007 if (need_to_setup_eol_systems)
|
|
|
1008 setup_eol_coding_systems (codesys);
|
|
|
1009
|
|
|
1010 {
|
|
|
1011 Lisp_Object codesys_obj;
|
|
|
1012 XSETCODING_SYSTEM (codesys_obj, codesys);
|
|
|
1013 Fputhash (name, codesys_obj, Vcoding_system_hash_table);
|
|
|
1014 return codesys_obj;
|
|
|
1015 }
|
|
|
1016 }
|
|
|
1017
|
|
|
1018 DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /*
|
|
|
1019 Copy OLD-CODING-SYSTEM to NEW-NAME.
|
|
|
1020 If NEW-NAME does not name an existing coding system, a new one will
|
|
|
1021 be created.
|
|
|
1022 */
|
|
|
1023 (old_coding_system, new_name))
|
|
|
1024 {
|
|
|
1025 Lisp_Object new_coding_system;
|
|
|
1026 old_coding_system = Fget_coding_system (old_coding_system);
|
|
|
1027 new_coding_system = Ffind_coding_system (new_name);
|
|
|
1028 if (NILP (new_coding_system))
|
|
|
1029 {
|
|
|
1030 XSETCODING_SYSTEM (new_coding_system,
|
|
|
1031 allocate_coding_system
|
|
|
1032 (XCODING_SYSTEM_TYPE (old_coding_system),
|
|
|
1033 new_name));
|
|
|
1034 Fputhash (new_name, new_coding_system, Vcoding_system_hash_table);
|
|
|
1035 }
|
|
|
1036
|
|
|
1037 {
|
|
|
1038 Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system);
|
|
|
1039 Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system);
|
|
|
1040 memcpy (((char *) to ) + sizeof (to->header),
|
|
|
1041 ((char *) from) + sizeof (from->header),
|
|
|
1042 sizeof (*from) - sizeof (from->header));
|
|
|
1043 to->name = new_name;
|
|
|
1044 }
|
|
|
1045 return new_coding_system;
|
|
|
1046 }
|
|
|
1047
|
|
440
|
1048 DEFUN ("coding-system-canonical-name-p", Fcoding_system_canonical_name_p, 1, 1, 0, /*
|
|
|
1049 Return t if OBJECT names a coding system, and is not a coding system alias.
|
|
428
|
1050 */
|
|
440
|
1051 (object))
|
|
|
1052 {
|
|
|
1053 return CODING_SYSTEMP (Fgethash (object, Vcoding_system_hash_table, Qnil))
|
|
|
1054 ? Qt : Qnil;
|
|
|
1055 }
|
|
|
1056
|
|
|
1057 DEFUN ("coding-system-alias-p", Fcoding_system_alias_p, 1, 1, 0, /*
|
|
|
1058 Return t if OBJECT is a coding system alias.
|
|
|
1059 All coding system aliases are created by `define-coding-system-alias'.
|
|
|
1060 */
|
|
|
1061 (object))
|
|
428
|
1062 {
|
|
440
|
1063 return SYMBOLP (Fgethash (object, Vcoding_system_hash_table, Qzero))
|
|
|
1064 ? Qt : Qnil;
|
|
|
1065 }
|
|
|
1066
|
|
|
1067 DEFUN ("coding-system-aliasee", Fcoding_system_aliasee, 1, 1, 0, /*
|
|
|
1068 Return the coding-system symbol for which symbol ALIAS is an alias.
|
|
|
1069 */
|
|
|
1070 (alias))
|
|
|
1071 {
|
|
|
1072 Lisp_Object aliasee = Fgethash (alias, Vcoding_system_hash_table, Qnil);
|
|
|
1073 if (SYMBOLP (aliasee))
|
|
|
1074 return aliasee;
|
|
|
1075 else
|
|
563
|
1076 invalid_argument ("Symbol is not a coding system alias", alias);
|
|
442
|
1077 return Qnil; /* To keep the compiler happy */
|
|
440
|
1078 }
|
|
|
1079
|
|
|
1080 static Lisp_Object
|
|
|
1081 append_suffix_to_symbol (Lisp_Object symbol, const char *ascii_string)
|
|
|
1082 {
|
|
|
1083 return Fintern (concat2 (Fsymbol_name (symbol), build_string (ascii_string)),
|
|
|
1084 Qnil);
|
|
|
1085 }
|
|
|
1086
|
|
|
1087 /* A maphash function, for removing dangling coding system aliases. */
|
|
|
1088 static int
|
|
|
1089 dangling_coding_system_alias_p (Lisp_Object alias,
|
|
|
1090 Lisp_Object aliasee,
|
|
|
1091 void *dangling_aliases)
|
|
|
1092 {
|
|
|
1093 if (SYMBOLP (aliasee)
|
|
|
1094 && NILP (Fgethash (aliasee, Vcoding_system_hash_table, Qnil)))
|
|
428
|
1095 {
|
|
440
|
1096 (*(int *) dangling_aliases)++;
|
|
|
1097 return 1;
|
|
428
|
1098 }
|
|
440
|
1099 else
|
|
|
1100 return 0;
|
|
|
1101 }
|
|
|
1102
|
|
|
1103 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, 2, 2, 0, /*
|
|
|
1104 Define symbol ALIAS as an alias for coding system ALIASEE.
|
|
|
1105
|
|
|
1106 You can use this function to redefine an alias that has already been defined,
|
|
|
1107 but you cannot redefine a name which is the canonical name for a coding system.
|
|
|
1108 \(a canonical name of a coding system is what is returned when you call
|
|
|
1109 `coding-system-name' on a coding system).
|
|
|
1110
|
|
|
1111 ALIASEE itself can be an alias, which allows you to define nested aliases.
|
|
|
1112
|
|
|
1113 You are forbidden, however, from creating alias loops or `dangling' aliases.
|
|
|
1114 These will be detected, and an error will be signaled if you attempt to do so.
|
|
|
1115
|
|
|
1116 If ALIASEE is nil, then ALIAS will simply be undefined.
|
|
|
1117
|
|
|
1118 See also `coding-system-alias-p', `coding-system-aliasee',
|
|
|
1119 and `coding-system-canonical-name-p'.
|
|
|
1120 */
|
|
|
1121 (alias, aliasee))
|
|
|
1122 {
|
|
|
1123 Lisp_Object real_coding_system, probe;
|
|
|
1124
|
|
|
1125 CHECK_SYMBOL (alias);
|
|
|
1126
|
|
|
1127 if (!NILP (Fcoding_system_canonical_name_p (alias)))
|
|
563
|
1128 invalid_change
|
|
440
|
1129 ("Symbol is the canonical name of a coding system and cannot be redefined",
|
|
|
1130 alias);
|
|
|
1131
|
|
|
1132 if (NILP (aliasee))
|
|
|
1133 {
|
|
|
1134 Lisp_Object subsidiary_unix = append_suffix_to_symbol (alias, "-unix");
|
|
|
1135 Lisp_Object subsidiary_dos = append_suffix_to_symbol (alias, "-dos");
|
|
|
1136 Lisp_Object subsidiary_mac = append_suffix_to_symbol (alias, "-mac");
|
|
|
1137
|
|
|
1138 Fremhash (alias, Vcoding_system_hash_table);
|
|
|
1139
|
|
|
1140 /* Undefine subsidiary aliases,
|
|
|
1141 presumably created by a previous call to this function */
|
|
|
1142 if (! NILP (Fcoding_system_alias_p (subsidiary_unix)) &&
|
|
|
1143 ! NILP (Fcoding_system_alias_p (subsidiary_dos)) &&
|
|
|
1144 ! NILP (Fcoding_system_alias_p (subsidiary_mac)))
|
|
|
1145 {
|
|
|
1146 Fdefine_coding_system_alias (subsidiary_unix, Qnil);
|
|
|
1147 Fdefine_coding_system_alias (subsidiary_dos, Qnil);
|
|
|
1148 Fdefine_coding_system_alias (subsidiary_mac, Qnil);
|
|
|
1149 }
|
|
|
1150
|
|
|
1151 /* Undefine dangling coding system aliases. */
|
|
|
1152 {
|
|
|
1153 int dangling_aliases;
|
|
|
1154
|
|
|
1155 do {
|
|
|
1156 dangling_aliases = 0;
|
|
|
1157 elisp_map_remhash (dangling_coding_system_alias_p,
|
|
|
1158 Vcoding_system_hash_table,
|
|
|
1159 &dangling_aliases);
|
|
|
1160 } while (dangling_aliases > 0);
|
|
|
1161 }
|
|
|
1162
|
|
|
1163 return Qnil;
|
|
|
1164 }
|
|
|
1165
|
|
|
1166 if (CODING_SYSTEMP (aliasee))
|
|
|
1167 aliasee = XCODING_SYSTEM_NAME (aliasee);
|
|
|
1168
|
|
|
1169 /* Checks that aliasee names a coding-system */
|
|
|
1170 real_coding_system = Fget_coding_system (aliasee);
|
|
|
1171
|
|
|
1172 /* Check for coding system alias loops */
|
|
|
1173 if (EQ (alias, aliasee))
|
|
563
|
1174 alias_loop: invalid_operation_2
|
|
440
|
1175 ("Attempt to create a coding system alias loop", alias, aliasee);
|
|
|
1176
|
|
|
1177 for (probe = aliasee;
|
|
|
1178 SYMBOLP (probe);
|
|
|
1179 probe = Fgethash (probe, Vcoding_system_hash_table, Qzero))
|
|
|
1180 {
|
|
|
1181 if (EQ (probe, alias))
|
|
|
1182 goto alias_loop;
|
|
|
1183 }
|
|
|
1184
|
|
|
1185 Fputhash (alias, aliasee, Vcoding_system_hash_table);
|
|
|
1186
|
|
|
1187 /* Set up aliases for subsidiaries.
|
|
|
1188 #### There must be a better way to handle subsidiary coding systems. */
|
|
|
1189 {
|
|
|
1190 static const char *suffixes[] = { "-unix", "-dos", "-mac" };
|
|
|
1191 int i;
|
|
|
1192 for (i = 0; i < countof (suffixes); i++)
|
|
|
1193 {
|
|
|
1194 Lisp_Object alias_subsidiary =
|
|
|
1195 append_suffix_to_symbol (alias, suffixes[i]);
|
|
|
1196 Lisp_Object aliasee_subsidiary =
|
|
|
1197 append_suffix_to_symbol (aliasee, suffixes[i]);
|
|
|
1198
|
|
|
1199 if (! NILP (Ffind_coding_system (aliasee_subsidiary)))
|
|
|
1200 Fdefine_coding_system_alias (alias_subsidiary, aliasee_subsidiary);
|
|
|
1201 }
|
|
|
1202 }
|
|
428
|
1203 /* FSF return value is a vector of [ALIAS-unix ALIAS-dos ALIAS-mac],
|
|
|
1204 but it doesn't look intentional, so I'd rather return something
|
|
|
1205 meaningful or nothing at all. */
|
|
|
1206 return Qnil;
|
|
|
1207 }
|
|
|
1208
|
|
|
1209 static Lisp_Object
|
|
438
|
1210 subsidiary_coding_system (Lisp_Object coding_system, eol_type_t type)
|
|
428
|
1211 {
|
|
|
1212 Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
|
|
|
1213 Lisp_Object new_coding_system;
|
|
|
1214
|
|
|
1215 if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
|
|
|
1216 return coding_system;
|
|
|
1217
|
|
|
1218 switch (type)
|
|
|
1219 {
|
|
|
1220 case EOL_AUTODETECT: return coding_system;
|
|
|
1221 case EOL_LF: new_coding_system = CODING_SYSTEM_EOL_LF (cs); break;
|
|
|
1222 case EOL_CR: new_coding_system = CODING_SYSTEM_EOL_CR (cs); break;
|
|
|
1223 case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break;
|
|
442
|
1224 default: abort (); return Qnil;
|
|
428
|
1225 }
|
|
|
1226
|
|
|
1227 return NILP (new_coding_system) ? coding_system : new_coding_system;
|
|
|
1228 }
|
|
|
1229
|
|
|
1230 DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /*
|
|
|
1231 Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE.
|
|
|
1232 */
|
|
|
1233 (coding_system, eol_type))
|
|
|
1234 {
|
|
|
1235 coding_system = Fget_coding_system (coding_system);
|
|
|
1236
|
|
|
1237 return subsidiary_coding_system (coding_system,
|
|
|
1238 symbol_to_eol_type (eol_type));
|
|
|
1239 }
|
|
|
1240
|
|
|
1241
|
|
|
1242 /************************************************************************/
|
|
|
1243 /* Coding system accessors */
|
|
|
1244 /************************************************************************/
|
|
|
1245
|
|
|
1246 DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /*
|
|
|
1247 Return the doc string for CODING-SYSTEM.
|
|
|
1248 */
|
|
|
1249 (coding_system))
|
|
|
1250 {
|
|
|
1251 coding_system = Fget_coding_system (coding_system);
|
|
|
1252 return XCODING_SYSTEM_DOC_STRING (coding_system);
|
|
|
1253 }
|
|
|
1254
|
|
|
1255 DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /*
|
|
|
1256 Return the type of CODING-SYSTEM.
|
|
|
1257 */
|
|
|
1258 (coding_system))
|
|
|
1259 {
|
|
|
1260 switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system)))
|
|
|
1261 {
|
|
|
1262 default: abort ();
|
|
|
1263 case CODESYS_AUTODETECT: return Qundecided;
|
|
|
1264 #ifdef MULE
|
|
|
1265 case CODESYS_SHIFT_JIS: return Qshift_jis;
|
|
|
1266 case CODESYS_ISO2022: return Qiso2022;
|
|
|
1267 case CODESYS_BIG5: return Qbig5;
|
|
|
1268 case CODESYS_UCS4: return Qucs4;
|
|
|
1269 case CODESYS_UTF8: return Qutf8;
|
|
|
1270 case CODESYS_CCL: return Qccl;
|
|
|
1271 #endif
|
|
|
1272 case CODESYS_NO_CONVERSION: return Qno_conversion;
|
|
|
1273 #ifdef DEBUG_XEMACS
|
|
|
1274 case CODESYS_INTERNAL: return Qinternal;
|
|
|
1275 #endif
|
|
|
1276 }
|
|
|
1277 }
|
|
|
1278
|
|
|
1279 #ifdef MULE
|
|
|
1280 static
|
|
|
1281 Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum)
|
|
|
1282 {
|
|
|
1283 Lisp_Object cs
|
|
|
1284 = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum);
|
|
|
1285
|
|
|
1286 return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil;
|
|
|
1287 }
|
|
|
1288 #endif /* MULE */
|
|
|
1289
|
|
|
1290 DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /*
|
|
|
1291 Return the PROP property of CODING-SYSTEM.
|
|
|
1292 */
|
|
|
1293 (coding_system, prop))
|
|
|
1294 {
|
|
|
1295 int i, ok = 0;
|
|
|
1296 enum coding_system_type type;
|
|
|
1297
|
|
|
1298 coding_system = Fget_coding_system (coding_system);
|
|
|
1299 CHECK_SYMBOL (prop);
|
|
|
1300 type = XCODING_SYSTEM_TYPE (coding_system);
|
|
|
1301
|
|
|
1302 for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++)
|
|
|
1303 if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop))
|
|
|
1304 {
|
|
|
1305 ok = 1;
|
|
|
1306 switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type)
|
|
|
1307 {
|
|
|
1308 case CODESYS_PROP_ALL_OK:
|
|
|
1309 break;
|
|
|
1310 #ifdef MULE
|
|
|
1311 case CODESYS_PROP_ISO2022:
|
|
|
1312 if (type != CODESYS_ISO2022)
|
|
563
|
1313 invalid_argument
|
|
428
|
1314 ("Property only valid in ISO2022 coding systems",
|
|
|
1315 prop);
|
|
|
1316 break;
|
|
|
1317
|
|
|
1318 case CODESYS_PROP_CCL:
|
|
|
1319 if (type != CODESYS_CCL)
|
|
563
|
1320 invalid_argument
|
|
428
|
1321 ("Property only valid in CCL coding systems",
|
|
|
1322 prop);
|
|
|
1323 break;
|
|
|
1324 #endif /* MULE */
|
|
|
1325 default:
|
|
|
1326 abort ();
|
|
|
1327 }
|
|
|
1328 }
|
|
|
1329
|
|
|
1330 if (!ok)
|
|
563
|
1331 invalid_constant ("Unrecognized property", prop);
|
|
428
|
1332
|
|
|
1333 if (EQ (prop, Qname))
|
|
|
1334 return XCODING_SYSTEM_NAME (coding_system);
|
|
|
1335 else if (EQ (prop, Qtype))
|
|
|
1336 return Fcoding_system_type (coding_system);
|
|
|
1337 else if (EQ (prop, Qdoc_string))
|
|
|
1338 return XCODING_SYSTEM_DOC_STRING (coding_system);
|
|
|
1339 else if (EQ (prop, Qmnemonic))
|
|
|
1340 return XCODING_SYSTEM_MNEMONIC (coding_system);
|
|
|
1341 else if (EQ (prop, Qeol_type))
|
|
|
1342 return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system));
|
|
|
1343 else if (EQ (prop, Qeol_lf))
|
|
|
1344 return XCODING_SYSTEM_EOL_LF (coding_system);
|
|
|
1345 else if (EQ (prop, Qeol_crlf))
|
|
|
1346 return XCODING_SYSTEM_EOL_CRLF (coding_system);
|
|
|
1347 else if (EQ (prop, Qeol_cr))
|
|
|
1348 return XCODING_SYSTEM_EOL_CR (coding_system);
|
|
|
1349 else if (EQ (prop, Qpost_read_conversion))
|
|
|
1350 return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system);
|
|
|
1351 else if (EQ (prop, Qpre_write_conversion))
|
|
|
1352 return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system);
|
|
|
1353 #ifdef MULE
|
|
|
1354 else if (type == CODESYS_ISO2022)
|
|
|
1355 {
|
|
|
1356 if (EQ (prop, Qcharset_g0))
|
|
|
1357 return coding_system_charset (coding_system, 0);
|
|
|
1358 else if (EQ (prop, Qcharset_g1))
|
|
|
1359 return coding_system_charset (coding_system, 1);
|
|
|
1360 else if (EQ (prop, Qcharset_g2))
|
|
|
1361 return coding_system_charset (coding_system, 2);
|
|
|
1362 else if (EQ (prop, Qcharset_g3))
|
|
|
1363 return coding_system_charset (coding_system, 3);
|
|
|
1364
|
|
|
1365 #define FORCE_CHARSET(charset_num) \
|
|
|
1366 (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \
|
|
|
1367 (coding_system, charset_num) ? Qt : Qnil)
|
|
|
1368
|
|
|
1369 else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0);
|
|
|
1370 else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1);
|
|
|
1371 else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2);
|
|
|
1372 else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3);
|
|
|
1373
|
|
|
1374 #define LISP_BOOLEAN(prop) \
|
|
|
1375 (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil)
|
|
|
1376
|
|
|
1377 else if (EQ (prop, Qshort)) return LISP_BOOLEAN (SHORT);
|
|
|
1378 else if (EQ (prop, Qno_ascii_eol)) return LISP_BOOLEAN (NO_ASCII_EOL);
|
|
|
1379 else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL);
|
|
|
1380 else if (EQ (prop, Qseven)) return LISP_BOOLEAN (SEVEN);
|
|
|
1381 else if (EQ (prop, Qlock_shift)) return LISP_BOOLEAN (LOCK_SHIFT);
|
|
|
1382 else if (EQ (prop, Qno_iso6429)) return LISP_BOOLEAN (NO_ISO6429);
|
|
|
1383 else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED);
|
|
|
1384
|
|
|
1385 else if (EQ (prop, Qinput_charset_conversion))
|
|
|
1386 return
|
|
|
1387 unparse_charset_conversion_specs
|
|
|
1388 (XCODING_SYSTEM (coding_system)->iso2022.input_conv);
|
|
|
1389 else if (EQ (prop, Qoutput_charset_conversion))
|
|
|
1390 return
|
|
|
1391 unparse_charset_conversion_specs
|
|
|
1392 (XCODING_SYSTEM (coding_system)->iso2022.output_conv);
|
|
|
1393 else
|
|
|
1394 abort ();
|
|
|
1395 }
|
|
|
1396 else if (type == CODESYS_CCL)
|
|
|
1397 {
|
|
|
1398 if (EQ (prop, Qdecode))
|
|
|
1399 return XCODING_SYSTEM_CCL_DECODE (coding_system);
|
|
|
1400 else if (EQ (prop, Qencode))
|
|
|
1401 return XCODING_SYSTEM_CCL_ENCODE (coding_system);
|
|
|
1402 else
|
|
|
1403 abort ();
|
|
|
1404 }
|
|
|
1405 #endif /* MULE */
|
|
|
1406 else
|
|
|
1407 abort ();
|
|
|
1408
|
|
|
1409 return Qnil; /* not reached */
|
|
|
1410 }
|
|
|
1411
|
|
|
1412
|
|
|
1413 /************************************************************************/
|
|
|
1414 /* Coding category functions */
|
|
|
1415 /************************************************************************/
|
|
|
1416
|
|
|
1417 static int
|
|
|
1418 decode_coding_category (Lisp_Object symbol)
|
|
|
1419 {
|
|
|
1420 int i;
|
|
|
1421
|
|
|
1422 CHECK_SYMBOL (symbol);
|
|
448
|
1423 for (i = 0; i < CODING_CATEGORY_LAST; i++)
|
|
428
|
1424 if (EQ (coding_category_symbol[i], symbol))
|
|
|
1425 return i;
|
|
|
1426
|
|
563
|
1427 invalid_constant ("Unrecognized coding category", symbol);
|
|
428
|
1428 return 0; /* not reached */
|
|
|
1429 }
|
|
|
1430
|
|
|
1431 DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /*
|
|
|
1432 Return a list of all recognized coding categories.
|
|
|
1433 */
|
|
|
1434 ())
|
|
|
1435 {
|
|
|
1436 int i;
|
|
|
1437 Lisp_Object list = Qnil;
|
|
|
1438
|
|
448
|
1439 for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
|
|
428
|
1440 list = Fcons (coding_category_symbol[i], list);
|
|
|
1441 return list;
|
|
|
1442 }
|
|
|
1443
|
|
|
1444 DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /*
|
|
|
1445 Change the priority order of the coding categories.
|
|
|
1446 LIST should be list of coding categories, in descending order of
|
|
|
1447 priority. Unspecified coding categories will be lower in priority
|
|
|
1448 than all specified ones, in the same relative order they were in
|
|
|
1449 previously.
|
|
|
1450 */
|
|
|
1451 (list))
|
|
|
1452 {
|
|
448
|
1453 int category_to_priority[CODING_CATEGORY_LAST];
|
|
428
|
1454 int i, j;
|
|
|
1455 Lisp_Object rest;
|
|
|
1456
|
|
|
1457 /* First generate a list that maps coding categories to priorities. */
|
|
|
1458
|
|
448
|
1459 for (i = 0; i < CODING_CATEGORY_LAST; i++)
|
|
428
|
1460 category_to_priority[i] = -1;
|
|
|
1461
|
|
|
1462 /* Highest priority comes from the specified list. */
|
|
|
1463 i = 0;
|
|
|
1464 EXTERNAL_LIST_LOOP (rest, list)
|
|
|
1465 {
|
|
|
1466 int cat = decode_coding_category (XCAR (rest));
|
|
|
1467
|
|
|
1468 if (category_to_priority[cat] >= 0)
|
|
563
|
1469 sferror ("Duplicate coding category in list", XCAR (rest));
|
|
428
|
1470 category_to_priority[cat] = i++;
|
|
|
1471 }
|
|
|
1472
|
|
|
1473 /* Now go through the existing categories by priority to retrieve
|
|
|
1474 the categories not yet specified and preserve their priority
|
|
|
1475 order. */
|
|
448
|
1476 for (j = 0; j < CODING_CATEGORY_LAST; j++)
|
|
428
|
1477 {
|
|
|
1478 int cat = fcd->coding_category_by_priority[j];
|
|
|
1479 if (category_to_priority[cat] < 0)
|
|
|
1480 category_to_priority[cat] = i++;
|
|
|
1481 }
|
|
|
1482
|
|
|
1483 /* Now we need to construct the inverse of the mapping we just
|
|
|
1484 constructed. */
|
|
|
1485
|
|
448
|
1486 for (i = 0; i < CODING_CATEGORY_LAST; i++)
|
|
428
|
1487 fcd->coding_category_by_priority[category_to_priority[i]] = i;
|
|
|
1488
|
|
|
1489 /* Phew! That was confusing. */
|
|
|
1490 return Qnil;
|
|
|
1491 }
|
|
|
1492
|
|
|
1493 DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /*
|
|
|
1494 Return a list of coding categories in descending order of priority.
|
|
|
1495 */
|
|
|
1496 ())
|
|
|
1497 {
|
|
|
1498 int i;
|
|
|
1499 Lisp_Object list = Qnil;
|
|
|
1500
|
|
448
|
1501 for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
|
|
428
|
1502 list = Fcons (coding_category_symbol[fcd->coding_category_by_priority[i]],
|
|
|
1503 list);
|
|
|
1504 return list;
|
|
|
1505 }
|
|
|
1506
|
|
|
1507 DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /*
|
|
|
1508 Change the coding system associated with a coding category.
|
|
|
1509 */
|
|
|
1510 (coding_category, coding_system))
|
|
|
1511 {
|
|
|
1512 int cat = decode_coding_category (coding_category);
|
|
|
1513
|
|
|
1514 coding_system = Fget_coding_system (coding_system);
|
|
|
1515 fcd->coding_category_system[cat] = coding_system;
|
|
|
1516 return Qnil;
|
|
|
1517 }
|
|
|
1518
|
|
|
1519 DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /*
|
|
|
1520 Return the coding system associated with a coding category.
|
|
|
1521 */
|
|
|
1522 (coding_category))
|
|
|
1523 {
|
|
|
1524 int cat = decode_coding_category (coding_category);
|
|
|
1525 Lisp_Object sys = fcd->coding_category_system[cat];
|
|
|
1526
|
|
|
1527 if (!NILP (sys))
|
|
|
1528 return XCODING_SYSTEM_NAME (sys);
|
|
|
1529 return Qnil;
|
|
|
1530 }
|
|
|
1531
|
|
|
1532
|
|
|
1533 /************************************************************************/
|
|
|
1534 /* Detecting the encoding of data */
|
|
|
1535 /************************************************************************/
|
|
|
1536
|
|
|
1537 struct detection_state
|
|
|
1538 {
|
|
438
|
1539 eol_type_t eol_type;
|
|
428
|
1540 int seen_non_ascii;
|
|
|
1541 int mask;
|
|
|
1542 #ifdef MULE
|
|
|
1543 struct
|
|
|
1544 {
|
|
|
1545 int mask;
|
|
|
1546 int in_second_byte;
|
|
|
1547 }
|
|
|
1548 big5;
|
|
|
1549
|
|
|
1550 struct
|
|
|
1551 {
|
|
|
1552 int mask;
|
|
|
1553 int in_second_byte;
|
|
|
1554 }
|
|
|
1555 shift_jis;
|
|
|
1556
|
|
|
1557 struct
|
|
|
1558 {
|
|
|
1559 int mask;
|
|
|
1560 int in_byte;
|
|
|
1561 }
|
|
|
1562 ucs4;
|
|
|
1563
|
|
|
1564 struct
|
|
|
1565 {
|
|
|
1566 int mask;
|
|
|
1567 int in_byte;
|
|
|
1568 }
|
|
|
1569 utf8;
|
|
|
1570
|
|
|
1571 struct
|
|
|
1572 {
|
|
|
1573 int mask;
|
|
|
1574 int initted;
|
|
|
1575 struct iso2022_decoder iso;
|
|
|
1576 unsigned int flags;
|
|
|
1577 int high_byte_count;
|
|
|
1578 unsigned int saw_single_shift:1;
|
|
|
1579 }
|
|
|
1580 iso2022;
|
|
|
1581 #endif
|
|
|
1582 struct
|
|
|
1583 {
|
|
|
1584 int seen_anything;
|
|
|
1585 int just_saw_cr;
|
|
|
1586 }
|
|
|
1587 eol;
|
|
|
1588 };
|
|
|
1589
|
|
|
1590 static int
|
|
|
1591 acceptable_control_char_p (int c)
|
|
|
1592 {
|
|
|
1593 switch (c)
|
|
|
1594 {
|
|
|
1595 /* Allow and ignore control characters that you might
|
|
|
1596 reasonably see in a text file */
|
|
|
1597 case '\r':
|
|
|
1598 case '\n':
|
|
|
1599 case '\t':
|
|
|
1600 case 7: /* bell */
|
|
|
1601 case 8: /* backspace */
|
|
|
1602 case 11: /* vertical tab */
|
|
|
1603 case 12: /* form feed */
|
|
|
1604 case 26: /* MS-DOS C-z junk */
|
|
|
1605 case 31: /* '^_' -- for info */
|
|
|
1606 return 1;
|
|
|
1607 default:
|
|
|
1608 return 0;
|
|
|
1609 }
|
|
|
1610 }
|
|
|
1611
|
|
|
1612 static int
|
|
|
1613 mask_has_at_most_one_bit_p (int mask)
|
|
|
1614 {
|
|
|
1615 /* Perhaps the only thing useful you learn from intensive Microsoft
|
|
|
1616 technical interviews */
|
|
|
1617 return (mask & (mask - 1)) == 0;
|
|
|
1618 }
|
|
|
1619
|
|
438
|
1620 static eol_type_t
|
|
444
|
1621 detect_eol_type (struct detection_state *st, const Extbyte *src,
|
|
462
|
1622 Lstream_data_count n)
|
|
428
|
1623 {
|
|
|
1624 while (n--)
|
|
|
1625 {
|
|
444
|
1626 unsigned char c = *(unsigned char *)src++;
|
|
428
|
1627 if (c == '\n')
|
|
|
1628 {
|
|
|
1629 if (st->eol.just_saw_cr)
|
|
|
1630 return EOL_CRLF;
|
|
|
1631 else if (st->eol.seen_anything)
|
|
|
1632 return EOL_LF;
|
|
|
1633 }
|
|
|
1634 else if (st->eol.just_saw_cr)
|
|
|
1635 return EOL_CR;
|
|
|
1636 else if (c == '\r')
|
|
|
1637 st->eol.just_saw_cr = 1;
|
|
|
1638 else
|
|
|
1639 st->eol.just_saw_cr = 0;
|
|
|
1640 st->eol.seen_anything = 1;
|
|
|
1641 }
|
|
|
1642
|
|
|
1643 return EOL_AUTODETECT;
|
|
|
1644 }
|
|
|
1645
|
|
|
1646 /* Attempt to determine the encoding and EOL type of the given text.
|
|
|
1647 Before calling this function for the first type, you must initialize
|
|
|
1648 st->eol_type as appropriate and initialize st->mask to ~0.
|
|
|
1649
|
|
|
1650 st->eol_type holds the determined EOL type, or EOL_AUTODETECT if
|
|
|
1651 not yet known.
|
|
|
1652
|
|
|
1653 st->mask holds the determined coding category mask, or ~0 if only
|
|
|
1654 ASCII has been seen so far.
|
|
|
1655
|
|
|
1656 Returns:
|
|
|
1657
|
|
|
1658 0 == st->eol_type is EOL_AUTODETECT and/or more than coding category
|
|
|
1659 is present in st->mask
|
|
|
1660 1 == definitive answers are here for both st->eol_type and st->mask
|
|
|
1661 */
|
|
|
1662
|
|
|
1663 static int
|
|
442
|
1664 detect_coding_type (struct detection_state *st, const Extbyte *src,
|
|
462
|
1665 Lstream_data_count n, int just_do_eol)
|
|
428
|
1666 {
|
|
|
1667 if (st->eol_type == EOL_AUTODETECT)
|
|
|
1668 st->eol_type = detect_eol_type (st, src, n);
|
|
|
1669
|
|
|
1670 if (just_do_eol)
|
|
|
1671 return st->eol_type != EOL_AUTODETECT;
|
|
|
1672
|
|
|
1673 if (!st->seen_non_ascii)
|
|
|
1674 {
|
|
|
1675 for (; n; n--, src++)
|
|
|
1676 {
|
|
444
|
1677 unsigned char c = *(unsigned char *) src;
|
|
428
|
1678 if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80)
|
|
|
1679 {
|
|
|
1680 st->seen_non_ascii = 1;
|
|
|
1681 #ifdef MULE
|
|
|
1682 st->shift_jis.mask = ~0;
|
|
|
1683 st->big5.mask = ~0;
|
|
|
1684 st->ucs4.mask = ~0;
|
|
|
1685 st->utf8.mask = ~0;
|
|
|
1686 st->iso2022.mask = ~0;
|
|
|
1687 #endif
|
|
|
1688 break;
|
|
|
1689 }
|
|
|
1690 }
|
|
|
1691 }
|
|
|
1692
|
|
|
1693 if (!n)
|
|
|
1694 return 0;
|
|
|
1695 #ifdef MULE
|
|
|
1696 if (!mask_has_at_most_one_bit_p (st->iso2022.mask))
|
|
|
1697 st->iso2022.mask = detect_coding_iso2022 (st, src, n);
|
|
|
1698 if (!mask_has_at_most_one_bit_p (st->shift_jis.mask))
|
|
|
1699 st->shift_jis.mask = detect_coding_sjis (st, src, n);
|
|
|
1700 if (!mask_has_at_most_one_bit_p (st->big5.mask))
|
|
|
1701 st->big5.mask = detect_coding_big5 (st, src, n);
|
|
|
1702 if (!mask_has_at_most_one_bit_p (st->utf8.mask))
|
|
|
1703 st->utf8.mask = detect_coding_utf8 (st, src, n);
|
|
|
1704 if (!mask_has_at_most_one_bit_p (st->ucs4.mask))
|
|
|
1705 st->ucs4.mask = detect_coding_ucs4 (st, src, n);
|
|
|
1706
|
|
|
1707 st->mask
|
|
|
1708 = st->iso2022.mask | st->shift_jis.mask | st->big5.mask
|
|
|
1709 | st->utf8.mask | st->ucs4.mask;
|
|
|
1710 #endif
|
|
|
1711 {
|
|
|
1712 int retval = mask_has_at_most_one_bit_p (st->mask);
|
|
|
1713 st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK;
|
|
|
1714 return retval && st->eol_type != EOL_AUTODETECT;
|
|
|
1715 }
|
|
|
1716 }
|
|
|
1717
|
|
|
1718 static Lisp_Object
|
|
|
1719 coding_system_from_mask (int mask)
|
|
|
1720 {
|
|
|
1721 if (mask == ~0)
|
|
|
1722 {
|
|
|
1723 /* If the file was entirely or basically ASCII, use the
|
|
|
1724 default value of `buffer-file-coding-system'. */
|
|
|
1725 Lisp_Object retval =
|
|
|
1726 XBUFFER (Vbuffer_defaults)->buffer_file_coding_system;
|
|
|
1727 if (!NILP (retval))
|
|
|
1728 {
|
|
|
1729 retval = Ffind_coding_system (retval);
|
|
|
1730 if (NILP (retval))
|
|
|
1731 {
|
|
|
1732 warn_when_safe
|
|
|
1733 (Qbad_variable, Qwarning,
|
|
|
1734 "Invalid `default-buffer-file-coding-system', set to nil");
|
|
|
1735 XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil;
|
|
|
1736 }
|
|
|
1737 }
|
|
|
1738 if (NILP (retval))
|
|
|
1739 retval = Fget_coding_system (Qraw_text);
|
|
|
1740 return retval;
|
|
|
1741 }
|
|
|
1742 else
|
|
|
1743 {
|
|
|
1744 int i;
|
|
|
1745 int cat = -1;
|
|
|
1746 #ifdef MULE
|
|
|
1747 mask = postprocess_iso2022_mask (mask);
|
|
|
1748 #endif
|
|
|
1749 /* Look through the coding categories by priority and find
|
|
|
1750 the first one that is allowed. */
|
|
448
|
1751 for (i = 0; i < CODING_CATEGORY_LAST; i++)
|
|
428
|
1752 {
|
|
|
1753 cat = fcd->coding_category_by_priority[i];
|
|
|
1754 if ((mask & (1 << cat)) &&
|
|
|
1755 !NILP (fcd->coding_category_system[cat]))
|
|
|
1756 break;
|
|
|
1757 }
|
|
|
1758 if (cat >= 0)
|
|
|
1759 return fcd->coding_category_system[cat];
|
|
|
1760 else
|
|
|
1761 return Fget_coding_system (Qraw_text);
|
|
|
1762 }
|
|
|
1763 }
|
|
|
1764
|
|
|
1765 /* Given a seekable read stream and potential coding system and EOL type
|
|
|
1766 as specified, do any autodetection that is called for. If the
|
|
|
1767 coding system and/or EOL type are not `autodetect', they will be left
|
|
|
1768 alone; but this function will never return an autodetect coding system
|
|
|
1769 or EOL type.
|
|
|
1770
|
|
|
1771 This function does not automatically fetch subsidiary coding systems;
|
|
|
1772 that should be unnecessary with the explicit eol-type argument. */
|
|
|
1773
|
|
|
1774 #define LENGTH(string_constant) (sizeof (string_constant) - 1)
|
|
|
1775
|
|
|
1776 void
|
|
|
1777 determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out,
|
|
438
|
1778 eol_type_t *eol_type_in_out)
|
|
428
|
1779 {
|
|
|
1780 struct detection_state decst;
|
|
|
1781
|
|
|
1782 if (*eol_type_in_out == EOL_AUTODETECT)
|
|
|
1783 *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out);
|
|
|
1784
|
|
|
1785 xzero (decst);
|
|
|
1786 decst.eol_type = *eol_type_in_out;
|
|
|
1787 decst.mask = ~0;
|
|
|
1788
|
|
|
1789 /* If autodetection is called for, do it now. */
|
|
|
1790 if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT
|
|
|
1791 || *eol_type_in_out == EOL_AUTODETECT)
|
|
|
1792 {
|
|
|
1793 Extbyte buf[4096];
|
|
|
1794 Lisp_Object coding_system = Qnil;
|
|
|
1795 Extbyte *p;
|
|
462
|
1796 Lstream_data_count nread = Lstream_read (stream, buf, sizeof (buf));
|
|
428
|
1797 Extbyte *scan_end;
|
|
|
1798
|
|
|
1799 /* Look for initial "-*-"; mode line prefix */
|
|
|
1800 for (p = buf,
|
|
|
1801 scan_end = buf + nread - LENGTH ("-*-coding:?-*-");
|
|
|
1802 p <= scan_end
|
|
|
1803 && *p != '\n'
|
|
|
1804 && *p != '\r';
|
|
|
1805 p++)
|
|
|
1806 if (*p == '-' && *(p+1) == '*' && *(p+2) == '-')
|
|
|
1807 {
|
|
|
1808 Extbyte *local_vars_beg = p + 3;
|
|
|
1809 /* Look for final "-*-"; mode line suffix */
|
|
|
1810 for (p = local_vars_beg,
|
|
|
1811 scan_end = buf + nread - LENGTH ("-*-");
|
|
|
1812 p <= scan_end
|
|
|
1813 && *p != '\n'
|
|
|
1814 && *p != '\r';
|
|
|
1815 p++)
|
|
|
1816 if (*p == '-' && *(p+1) == '*' && *(p+2) == '-')
|
|
|
1817 {
|
|
|
1818 Extbyte *suffix = p;
|
|
|
1819 /* Look for "coding:" */
|
|
|
1820 for (p = local_vars_beg,
|
|
|
1821 scan_end = suffix - LENGTH ("coding:?");
|
|
|
1822 p <= scan_end;
|
|
|
1823 p++)
|
|
|
1824 if (memcmp ("coding:", p, LENGTH ("coding:")) == 0
|
|
|
1825 && (p == local_vars_beg
|
|
|
1826 || (*(p-1) == ' ' ||
|
|
|
1827 *(p-1) == '\t' ||
|
|
|
1828 *(p-1) == ';')))
|
|
|
1829 {
|
|
|
1830 Extbyte save;
|
|
|
1831 int n;
|
|
|
1832 p += LENGTH ("coding:");
|
|
|
1833 while (*p == ' ' || *p == '\t') p++;
|
|
|
1834
|
|
|
1835 /* Get coding system name */
|
|
|
1836 save = *suffix; *suffix = '\0';
|
|
|
1837 /* Characters valid in a MIME charset name (rfc 1521),
|
|
|
1838 and in a Lisp symbol name. */
|
|
|
1839 n = strspn ( (char *) p,
|
|
|
1840 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
|
|
1841 "abcdefghijklmnopqrstuvwxyz"
|
|
|
1842 "0123456789"
|
|
|
1843 "!$%&*+-.^_{|}~");
|
|
|
1844 *suffix = save;
|
|
|
1845 if (n > 0)
|
|
|
1846 {
|
|
|
1847 save = p[n]; p[n] = '\0';
|
|
|
1848 coding_system =
|
|
|
1849 Ffind_coding_system (intern ((char *) p));
|
|
|
1850 p[n] = save;
|
|
|
1851 }
|
|
|
1852 break;
|
|
|
1853 }
|
|
|
1854 break;
|
|
|
1855 }
|
|
|
1856 break;
|
|
|
1857 }
|
|
|
1858
|
|
|
1859 if (NILP (coding_system))
|
|
|
1860 do
|
|
|
1861 {
|
|
|
1862 if (detect_coding_type (&decst, buf, nread,
|
|
|
1863 XCODING_SYSTEM_TYPE (*codesys_in_out)
|
|
|
1864 != CODESYS_AUTODETECT))
|
|
|
1865 break;
|
|
|
1866 nread = Lstream_read (stream, buf, sizeof (buf));
|
|
|
1867 if (nread == 0)
|
|
|
1868 break;
|
|
|
1869 }
|
|
|
1870 while (1);
|
|
|
1871
|
|
|
1872 else if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT
|
|
|
1873 && XCODING_SYSTEM_EOL_TYPE (coding_system) == EOL_AUTODETECT)
|
|
|
1874 do
|
|
|
1875 {
|
|
|
1876 if (detect_coding_type (&decst, buf, nread, 1))
|
|
|
1877 break;
|
|
|
1878 nread = Lstream_read (stream, buf, sizeof (buf));
|
|
|
1879 if (!nread)
|
|
|
1880 break;
|
|
|
1881 }
|
|
|
1882 while (1);
|
|
|
1883
|
|
|
1884 *eol_type_in_out = decst.eol_type;
|
|
|
1885 if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT)
|
|
|
1886 {
|
|
|
1887 if (NILP (coding_system))
|
|
|
1888 *codesys_in_out = coding_system_from_mask (decst.mask);
|
|
|
1889 else
|
|
|
1890 *codesys_in_out = coding_system;
|
|
|
1891 }
|
|
|
1892 }
|
|
|
1893
|
|
|
1894 /* If we absolutely can't determine the EOL type, just assume LF. */
|
|
|
1895 if (*eol_type_in_out == EOL_AUTODETECT)
|
|
|
1896 *eol_type_in_out = EOL_LF;
|
|
|
1897
|
|
|
1898 Lstream_rewind (stream);
|
|
|
1899 }
|
|
|
1900
|
|
|
1901 DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /*
|
|
|
1902 Detect coding system of the text in the region between START and END.
|
|
444
|
1903 Return a list of possible coding systems ordered by priority.
|
|
|
1904 If only ASCII characters are found, return 'undecided or one of
|
|
428
|
1905 its subsidiary coding systems according to a detected end-of-line
|
|
|
1906 type. Optional arg BUFFER defaults to the current buffer.
|
|
|
1907 */
|
|
|
1908 (start, end, buffer))
|
|
|
1909 {
|
|
|
1910 Lisp_Object val = Qnil;
|
|
|
1911 struct buffer *buf = decode_buffer (buffer, 0);
|
|
|
1912 Bufpos b, e;
|
|
|
1913 Lisp_Object instream, lb_instream;
|
|
|
1914 Lstream *istr, *lb_istr;
|
|
|
1915 struct detection_state decst;
|
|
|
1916 struct gcpro gcpro1, gcpro2;
|
|
|
1917
|
|
|
1918 get_buffer_range_char (buf, start, end, &b, &e, 0);
|
|
|
1919 lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0);
|
|
|
1920 lb_istr = XLSTREAM (lb_instream);
|
|
|
1921 instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary));
|
|
|
1922 istr = XLSTREAM (instream);
|
|
|
1923 GCPRO2 (instream, lb_instream);
|
|
|
1924 xzero (decst);
|
|
|
1925 decst.eol_type = EOL_AUTODETECT;
|
|
|
1926 decst.mask = ~0;
|
|
|
1927 while (1)
|
|
|
1928 {
|
|
444
|
1929 Extbyte random_buffer[4096];
|
|
462
|
1930 Lstream_data_count nread = Lstream_read (istr, random_buffer, sizeof (random_buffer));
|
|
428
|
1931
|
|
|
1932 if (!nread)
|
|
|
1933 break;
|
|
|
1934 if (detect_coding_type (&decst, random_buffer, nread, 0))
|
|
|
1935 break;
|
|
|
1936 }
|
|
|
1937
|
|
|
1938 if (decst.mask == ~0)
|
|
|
1939 val = subsidiary_coding_system (Fget_coding_system (Qundecided),
|
|
|
1940 decst.eol_type);
|
|
|
1941 else
|
|
|
1942 {
|
|
|
1943 int i;
|
|
|
1944
|
|
|
1945 val = Qnil;
|
|
|
1946 #ifdef MULE
|
|
|
1947 decst.mask = postprocess_iso2022_mask (decst.mask);
|
|
|
1948 #endif
|
|
448
|
1949 for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
|
|
428
|
1950 {
|
|
|
1951 int sys = fcd->coding_category_by_priority[i];
|
|
|
1952 if (decst.mask & (1 << sys))
|
|
|
1953 {
|
|
|
1954 Lisp_Object codesys = fcd->coding_category_system[sys];
|
|
|
1955 if (!NILP (codesys))
|
|
|
1956 codesys = subsidiary_coding_system (codesys, decst.eol_type);
|
|
|
1957 val = Fcons (codesys, val);
|
|
|
1958 }
|
|
|
1959 }
|
|
|
1960 }
|
|
|
1961 Lstream_close (istr);
|
|
|
1962 UNGCPRO;
|
|
|
1963 Lstream_delete (istr);
|
|
|
1964 Lstream_delete (lb_istr);
|
|
|
1965 return val;
|
|
|
1966 }
|
|
|
1967
|
|
|
1968
|
|
|
1969 /************************************************************************/
|
|
|
1970 /* Converting to internal Mule format ("decoding") */
|
|
|
1971 /************************************************************************/
|
|
|
1972
|
|
|
1973 /* A decoding stream is a stream used for decoding text (i.e.
|
|
|
1974 converting from some external format to internal format).
|
|
|
1975 The decoding-stream object keeps track of the actual coding
|
|
|
1976 stream, the stream that is at the other end, and data that
|
|
|
1977 needs to be persistent across the lifetime of the stream. */
|
|
|
1978
|
|
|
1979 /* Handle the EOL stuff related to just-read-in character C.
|
|
|
1980 EOL_TYPE is the EOL type of the coding stream.
|
|
|
1981 FLAGS is the current value of FLAGS in the coding stream, and may
|
|
|
1982 be modified by this macro. (The macro only looks at the
|
|
|
1983 CODING_STATE_CR flag.) DST is the Dynarr to which the decoded
|
|
|
1984 bytes are to be written. You need to also define a local goto
|
|
|
1985 label "label_continue_loop" that is at the end of the main
|
|
|
1986 character-reading loop.
|
|
|
1987
|
|
|
1988 If C is a CR character, then this macro handles it entirely and
|
|
|
1989 jumps to label_continue_loop. Otherwise, this macro does not add
|
|
|
1990 anything to DST, and continues normally. You should continue
|
|
|
1991 processing C normally after this macro. */
|
|
|
1992
|
|
|
1993 #define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst) \
|
|
|
1994 do { \
|
|
|
1995 if (c == '\r') \
|
|
|
1996 { \
|
|
|
1997 if (eol_type == EOL_CR) \
|
|
|
1998 Dynarr_add (dst, '\n'); \
|
|
|
1999 else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \
|
|
|
2000 Dynarr_add (dst, c); \
|
|
|
2001 else \
|
|
|
2002 flags |= CODING_STATE_CR; \
|
|
|
2003 goto label_continue_loop; \
|
|
|
2004 } \
|
|
|
2005 else if (flags & CODING_STATE_CR) \
|
|
|
2006 { /* eol_type == CODING_SYSTEM_EOL_CRLF */ \
|
|
|
2007 if (c != '\n') \
|
|
|
2008 Dynarr_add (dst, '\r'); \
|
|
|
2009 flags &= ~CODING_STATE_CR; \
|
|
|
2010 } \
|
|
|
2011 } while (0)
|
|
|
2012
|
|
|
2013 /* C should be a binary character in the range 0 - 255; convert
|
|
|
2014 to internal format and add to Dynarr DST. */
|
|
|
2015
|
|
|
2016 #define DECODE_ADD_BINARY_CHAR(c, dst) \
|
|
|
2017 do { \
|
|
|
2018 if (BYTE_ASCII_P (c)) \
|
|
|
2019 Dynarr_add (dst, c); \
|
|
|
2020 else if (BYTE_C1_P (c)) \
|
|
|
2021 { \
|
|
|
2022 Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \
|
|
|
2023 Dynarr_add (dst, c + 0x20); \
|
|
|
2024 } \
|
|
|
2025 else \
|
|
|
2026 { \
|
|
|
2027 Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \
|
|
|
2028 Dynarr_add (dst, c); \
|
|
|
2029 } \
|
|
|
2030 } while (0)
|
|
|
2031
|
|
|
2032 #define DECODE_OUTPUT_PARTIAL_CHAR(ch) \
|
|
|
2033 do { \
|
|
|
2034 if (ch) \
|
|
|
2035 { \
|
|
|
2036 DECODE_ADD_BINARY_CHAR (ch, dst); \
|
|
|
2037 ch = 0; \
|
|
|
2038 } \
|
|
|
2039 } while (0)
|
|
|
2040
|
|
|
2041 #define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \
|
|
|
2042 do { \
|
|
|
2043 if (flags & CODING_STATE_END) \
|
|
|
2044 { \
|
|
|
2045 DECODE_OUTPUT_PARTIAL_CHAR (ch); \
|
|
|
2046 if (flags & CODING_STATE_CR) \
|
|
|
2047 Dynarr_add (dst, '\r'); \
|
|
|
2048 } \
|
|
|
2049 } while (0)
|
|
|
2050
|
|
|
2051 #define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding)
|
|
|
2052
|
|
|
2053 struct decoding_stream
|
|
|
2054 {
|
|
|
2055 /* Coding system that governs the conversion. */
|
|
|
2056 Lisp_Coding_System *codesys;
|
|
|
2057
|
|
|
2058 /* Stream that we read the encoded data from or
|
|
|
2059 write the decoded data to. */
|
|
|
2060 Lstream *other_end;
|
|
|
2061
|
|
|
2062 /* If we are reading, then we can return only a fixed amount of
|
|
|
2063 data, so if the conversion resulted in too much data, we store it
|
|
|
2064 here for retrieval the next time around. */
|
|
|
2065 unsigned_char_dynarr *runoff;
|
|
|
2066
|
|
|
2067 /* FLAGS holds flags indicating the current state of the decoding.
|
|
|
2068 Some of these flags are dependent on the coding system. */
|
|
|
2069 unsigned int flags;
|
|
|
2070
|
|
|
2071 /* CH holds a partially built-up character. Since we only deal
|
|
|
2072 with one- and two-byte characters at the moment, we only use
|
|
|
2073 this to store the first byte of a two-byte character. */
|
|
|
2074 unsigned int ch;
|
|
|
2075
|
|
|
2076 /* EOL_TYPE specifies the type of end-of-line conversion that
|
|
|
2077 currently applies. We need to keep this separate from the
|
|
|
2078 EOL type stored in CODESYS because the latter might indicate
|
|
|
2079 automatic EOL-type detection while the former will always
|
|
|
2080 indicate a particular EOL type. */
|
|
438
|
2081 eol_type_t eol_type;
|
|
428
|
2082 #ifdef MULE
|
|
|
2083 /* Additional ISO2022 information. We define the structure above
|
|
|
2084 because it's also needed by the detection routines. */
|
|
|
2085 struct iso2022_decoder iso2022;
|
|
|
2086
|
|
|
2087 /* Additional information (the state of the running CCL program)
|
|
|
2088 used by the CCL decoder. */
|
|
|
2089 struct ccl_program ccl;
|
|
|
2090
|
|
|
2091 /* counter for UTF-8 or UCS-4 */
|
|
|
2092 unsigned char counter;
|
|
|
2093 #endif
|
|
|
2094 struct detection_state decst;
|
|
|
2095 };
|
|
|
2096
|
|
462
|
2097 static Lstream_data_count decoding_reader (Lstream *stream,
|
|
|
2098 unsigned char *data, Lstream_data_count size);
|
|
|
2099 static Lstream_data_count decoding_writer (Lstream *stream,
|
|
|
2100 const unsigned char *data, Lstream_data_count size);
|
|
428
|
2101 static int decoding_rewinder (Lstream *stream);
|
|
|
2102 static int decoding_seekable_p (Lstream *stream);
|
|
|
2103 static int decoding_flusher (Lstream *stream);
|
|
|
2104 static int decoding_closer (Lstream *stream);
|
|
|
2105
|
|
|
2106 static Lisp_Object decoding_marker (Lisp_Object stream);
|
|
|
2107
|
|
|
2108 DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding,
|
|
|
2109 sizeof (struct decoding_stream));
|
|
|
2110
|
|
|
2111 static Lisp_Object
|
|
|
2112 decoding_marker (Lisp_Object stream)
|
|
|
2113 {
|
|
|
2114 Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end;
|
|
|
2115 Lisp_Object str_obj;
|
|
|
2116
|
|
|
2117 /* We do not need to mark the coding systems or charsets stored
|
|
|
2118 within the stream because they are stored in a global list
|
|
|
2119 and automatically marked. */
|
|
|
2120
|
|
|
2121 XSETLSTREAM (str_obj, str);
|
|
|
2122 mark_object (str_obj);
|
|
|
2123 if (str->imp->marker)
|
|
|
2124 return (str->imp->marker) (str_obj);
|
|
|
2125 else
|
|
|
2126 return Qnil;
|
|
|
2127 }
|
|
|
2128
|
|
|
2129 /* Read SIZE bytes of data and store it into DATA. We are a decoding stream
|
|
|
2130 so we read data from the other end, decode it, and store it into DATA. */
|
|
|
2131
|
|
462
|
2132 static Lstream_data_count
|
|
|
2133 decoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
|
|
428
|
2134 {
|
|
|
2135 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2136 unsigned char *orig_data = data;
|
|
462
|
2137 Lstream_data_count read_size;
|
|
428
|
2138 int error_occurred = 0;
|
|
|
2139
|
|
|
2140 /* We need to interface to mule_decode(), which expects to take some
|
|
|
2141 amount of data and store the result into a Dynarr. We have
|
|
|
2142 mule_decode() store into str->runoff, and take data from there
|
|
|
2143 as necessary. */
|
|
|
2144
|
|
|
2145 /* We loop until we have enough data, reading chunks from the other
|
|
|
2146 end and decoding it. */
|
|
|
2147 while (1)
|
|
|
2148 {
|
|
|
2149 /* Take data from the runoff if we can. Make sure to take at
|
|
|
2150 most SIZE bytes, and delete the data from the runoff. */
|
|
|
2151 if (Dynarr_length (str->runoff) > 0)
|
|
|
2152 {
|
|
462
|
2153 Lstream_data_count chunk = min (size, (Lstream_data_count) Dynarr_length (str->runoff));
|
|
428
|
2154 memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
|
|
|
2155 Dynarr_delete_many (str->runoff, 0, chunk);
|
|
|
2156 data += chunk;
|
|
|
2157 size -= chunk;
|
|
|
2158 }
|
|
|
2159
|
|
|
2160 if (size == 0)
|
|
|
2161 break; /* No more room for data */
|
|
|
2162
|
|
|
2163 if (str->flags & CODING_STATE_END)
|
|
|
2164 /* This means that on the previous iteration, we hit the EOF on
|
|
|
2165 the other end. We loop once more so that mule_decode() can
|
|
|
2166 output any final stuff it may be holding, or any "go back
|
|
|
2167 to a sane state" escape sequences. (This latter makes sense
|
|
|
2168 during encoding.) */
|
|
|
2169 break;
|
|
|
2170
|
|
|
2171 /* Exhausted the runoff, so get some more. DATA has at least
|
|
|
2172 SIZE bytes left of storage in it, so it's OK to read directly
|
|
|
2173 into it. (We'll be overwriting above, after we've decoded it
|
|
|
2174 into the runoff.) */
|
|
|
2175 read_size = Lstream_read (str->other_end, data, size);
|
|
|
2176 if (read_size < 0)
|
|
|
2177 {
|
|
|
2178 error_occurred = 1;
|
|
|
2179 break;
|
|
|
2180 }
|
|
|
2181 if (read_size == 0)
|
|
|
2182 /* There might be some more end data produced in the translation.
|
|
|
2183 See the comment above. */
|
|
|
2184 str->flags |= CODING_STATE_END;
|
|
444
|
2185 mule_decode (stream, (Extbyte *) data, str->runoff, read_size);
|
|
428
|
2186 }
|
|
|
2187
|
|
|
2188 if (data - orig_data == 0)
|
|
|
2189 return error_occurred ? -1 : 0;
|
|
|
2190 else
|
|
|
2191 return data - orig_data;
|
|
|
2192 }
|
|
|
2193
|
|
462
|
2194 static Lstream_data_count
|
|
|
2195 decoding_writer (Lstream *stream, const unsigned char *data, Lstream_data_count size)
|
|
428
|
2196 {
|
|
|
2197 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
462
|
2198 Lstream_data_count retval;
|
|
428
|
2199
|
|
|
2200 /* Decode all our data into the runoff, and then attempt to write
|
|
|
2201 it all out to the other end. Remove whatever chunk we succeeded
|
|
|
2202 in writing. */
|
|
444
|
2203 mule_decode (stream, (Extbyte *) data, str->runoff, size);
|
|
428
|
2204 retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
|
|
|
2205 Dynarr_length (str->runoff));
|
|
|
2206 if (retval > 0)
|
|
|
2207 Dynarr_delete_many (str->runoff, 0, retval);
|
|
|
2208 /* Do NOT return retval. The return value indicates how much
|
|
|
2209 of the incoming data was written, not how many bytes were
|
|
|
2210 written. */
|
|
|
2211 return size;
|
|
|
2212 }
|
|
|
2213
|
|
|
2214 static void
|
|
|
2215 reset_decoding_stream (struct decoding_stream *str)
|
|
|
2216 {
|
|
|
2217 #ifdef MULE
|
|
|
2218 if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022)
|
|
|
2219 {
|
|
|
2220 Lisp_Object coding_system;
|
|
|
2221 XSETCODING_SYSTEM (coding_system, str->codesys);
|
|
|
2222 reset_iso2022 (coding_system, &str->iso2022);
|
|
|
2223 }
|
|
|
2224 else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL)
|
|
|
2225 {
|
|
|
2226 setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys));
|
|
|
2227 }
|
|
|
2228 str->counter = 0;
|
|
|
2229 #endif /* MULE */
|
|
442
|
2230 if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT
|
|
|
2231 || CODING_SYSTEM_EOL_TYPE (str->codesys) == EOL_AUTODETECT)
|
|
|
2232 {
|
|
|
2233 xzero (str->decst);
|
|
|
2234 str->decst.eol_type = EOL_AUTODETECT;
|
|
|
2235 str->decst.mask = ~0;
|
|
|
2236 }
|
|
428
|
2237 str->flags = str->ch = 0;
|
|
|
2238 }
|
|
|
2239
|
|
|
2240 static int
|
|
|
2241 decoding_rewinder (Lstream *stream)
|
|
|
2242 {
|
|
|
2243 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2244 reset_decoding_stream (str);
|
|
|
2245 Dynarr_reset (str->runoff);
|
|
|
2246 return Lstream_rewind (str->other_end);
|
|
|
2247 }
|
|
|
2248
|
|
|
2249 static int
|
|
|
2250 decoding_seekable_p (Lstream *stream)
|
|
|
2251 {
|
|
|
2252 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2253 return Lstream_seekable_p (str->other_end);
|
|
|
2254 }
|
|
|
2255
|
|
|
2256 static int
|
|
|
2257 decoding_flusher (Lstream *stream)
|
|
|
2258 {
|
|
|
2259 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2260 return Lstream_flush (str->other_end);
|
|
|
2261 }
|
|
|
2262
|
|
|
2263 static int
|
|
|
2264 decoding_closer (Lstream *stream)
|
|
|
2265 {
|
|
|
2266 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2267 if (stream->flags & LSTREAM_FL_WRITE)
|
|
|
2268 {
|
|
|
2269 str->flags |= CODING_STATE_END;
|
|
|
2270 decoding_writer (stream, 0, 0);
|
|
|
2271 }
|
|
|
2272 Dynarr_free (str->runoff);
|
|
|
2273 #ifdef MULE
|
|
|
2274 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
2275 if (str->iso2022.composite_chars)
|
|
|
2276 Dynarr_free (str->iso2022.composite_chars);
|
|
|
2277 #endif
|
|
|
2278 #endif
|
|
|
2279 return Lstream_close (str->other_end);
|
|
|
2280 }
|
|
|
2281
|
|
|
2282 Lisp_Object
|
|
|
2283 decoding_stream_coding_system (Lstream *stream)
|
|
|
2284 {
|
|
|
2285 Lisp_Object coding_system;
|
|
|
2286 struct decoding_stream *str = DECODING_STREAM_DATA (stream);
|
|
|
2287
|
|
|
2288 XSETCODING_SYSTEM (coding_system, str->codesys);
|
|
|
2289 return subsidiary_coding_system (coding_system, str->eol_type);
|
|
|
2290 }
|
|
|
2291
|
|
|
2292 void
|
|
|
2293 set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
|
|
|
2294 {
|
|
|
2295 Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
|
|
|
2296 struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
|
|
|
2297 str->codesys = cs;
|
|
|
2298 if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
|
|
|
2299 str->eol_type = CODING_SYSTEM_EOL_TYPE (cs);
|
|
|
2300 reset_decoding_stream (str);
|
|
|
2301 }
|
|
|
2302
|
|
|
2303 /* WARNING WARNING WARNING WARNING!!!!! If you open up a decoding
|
|
|
2304 stream for writing, no automatic code detection will be performed.
|
|
|
2305 The reason for this is that automatic code detection requires a
|
|
|
2306 seekable input. Things will also fail if you open a decoding
|
|
|
2307 stream for reading using a non-fully-specified coding system and
|
|
|
2308 a non-seekable input stream. */
|
|
|
2309
|
|
|
2310 static Lisp_Object
|
|
|
2311 make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys,
|
|
442
|
2312 const char *mode)
|
|
428
|
2313 {
|
|
|
2314 Lstream *lstr = Lstream_new (lstream_decoding, mode);
|
|
|
2315 struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
|
|
|
2316 Lisp_Object obj;
|
|
|
2317
|
|
|
2318 xzero (*str);
|
|
|
2319 str->other_end = stream;
|
|
|
2320 str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char);
|
|
|
2321 str->eol_type = EOL_AUTODETECT;
|
|
|
2322 if (!strcmp (mode, "r")
|
|
|
2323 && Lstream_seekable_p (stream))
|
|
|
2324 /* We can determine the coding system now. */
|
|
|
2325 determine_real_coding_system (stream, &codesys, &str->eol_type);
|
|
|
2326 set_decoding_stream_coding_system (lstr, codesys);
|
|
|
2327 str->decst.eol_type = str->eol_type;
|
|
|
2328 str->decst.mask = ~0;
|
|
|
2329 XSETLSTREAM (obj, lstr);
|
|
|
2330 return obj;
|
|
|
2331 }
|
|
|
2332
|
|
|
2333 Lisp_Object
|
|
|
2334 make_decoding_input_stream (Lstream *stream, Lisp_Object codesys)
|
|
|
2335 {
|
|
|
2336 return make_decoding_stream_1 (stream, codesys, "r");
|
|
|
2337 }
|
|
|
2338
|
|
|
2339 Lisp_Object
|
|
|
2340 make_decoding_output_stream (Lstream *stream, Lisp_Object codesys)
|
|
|
2341 {
|
|
|
2342 return make_decoding_stream_1 (stream, codesys, "w");
|
|
|
2343 }
|
|
|
2344
|
|
|
2345 /* Note: the decode_coding_* functions all take the same
|
|
|
2346 arguments as mule_decode(), which is to say some SRC data of
|
|
|
2347 size N, which is to be stored into dynamic array DST.
|
|
|
2348 DECODING is the stream within which the decoding is
|
|
|
2349 taking place, but no data is actually read from or
|
|
|
2350 written to that stream; that is handled in decoding_reader()
|
|
|
2351 or decoding_writer(). This allows the same functions to
|
|
|
2352 be used for both reading and writing. */
|
|
|
2353
|
|
|
2354 static void
|
|
444
|
2355 mule_decode (Lstream *decoding, const Extbyte *src,
|
|
462
|
2356 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
2357 {
|
|
|
2358 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
2359
|
|
|
2360 /* If necessary, do encoding-detection now. We do this when
|
|
|
2361 we're a writing stream or a non-seekable reading stream,
|
|
|
2362 meaning that we can't just process the whole input,
|
|
|
2363 rewind, and start over. */
|
|
|
2364
|
|
|
2365 if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT ||
|
|
|
2366 str->eol_type == EOL_AUTODETECT)
|
|
|
2367 {
|
|
|
2368 Lisp_Object codesys;
|
|
|
2369
|
|
|
2370 XSETCODING_SYSTEM (codesys, str->codesys);
|
|
|
2371 detect_coding_type (&str->decst, src, n,
|
|
|
2372 CODING_SYSTEM_TYPE (str->codesys) !=
|
|
|
2373 CODESYS_AUTODETECT);
|
|
|
2374 if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT &&
|
|
|
2375 str->decst.mask != ~0)
|
|
|
2376 /* #### This is cheesy. What we really ought to do is
|
|
|
2377 buffer up a certain amount of data so as to get a
|
|
|
2378 less random result. */
|
|
|
2379 codesys = coding_system_from_mask (str->decst.mask);
|
|
|
2380 str->eol_type = str->decst.eol_type;
|
|
|
2381 if (XCODING_SYSTEM (codesys) != str->codesys)
|
|
|
2382 {
|
|
|
2383 /* Preserve the CODING_STATE_END flag in case it was set.
|
|
|
2384 If we erase it, bad things might happen. */
|
|
|
2385 int was_end = str->flags & CODING_STATE_END;
|
|
|
2386 set_decoding_stream_coding_system (decoding, codesys);
|
|
|
2387 if (was_end)
|
|
|
2388 str->flags |= CODING_STATE_END;
|
|
|
2389 }
|
|
|
2390 }
|
|
|
2391
|
|
|
2392 switch (CODING_SYSTEM_TYPE (str->codesys))
|
|
|
2393 {
|
|
|
2394 #ifdef DEBUG_XEMACS
|
|
|
2395 case CODESYS_INTERNAL:
|
|
|
2396 Dynarr_add_many (dst, src, n);
|
|
|
2397 break;
|
|
|
2398 #endif
|
|
|
2399 case CODESYS_AUTODETECT:
|
|
|
2400 /* If we got this far and still haven't decided on the coding
|
|
|
2401 system, then do no conversion. */
|
|
|
2402 case CODESYS_NO_CONVERSION:
|
|
|
2403 decode_coding_no_conversion (decoding, src, dst, n);
|
|
|
2404 break;
|
|
|
2405 #ifdef MULE
|
|
|
2406 case CODESYS_SHIFT_JIS:
|
|
|
2407 decode_coding_sjis (decoding, src, dst, n);
|
|
|
2408 break;
|
|
|
2409 case CODESYS_BIG5:
|
|
|
2410 decode_coding_big5 (decoding, src, dst, n);
|
|
|
2411 break;
|
|
|
2412 case CODESYS_UCS4:
|
|
|
2413 decode_coding_ucs4 (decoding, src, dst, n);
|
|
|
2414 break;
|
|
|
2415 case CODESYS_UTF8:
|
|
|
2416 decode_coding_utf8 (decoding, src, dst, n);
|
|
|
2417 break;
|
|
|
2418 case CODESYS_CCL:
|
|
|
2419 str->ccl.last_block = str->flags & CODING_STATE_END;
|
|
444
|
2420 /* When applying ccl program to stream, MUST NOT set NULL
|
|
|
2421 pointer to src. */
|
|
|
2422 ccl_driver (&str->ccl, (src ? (unsigned char *)src : (unsigned char*)""),
|
|
|
2423 dst, n, 0, CCL_MODE_DECODING);
|
|
428
|
2424 break;
|
|
|
2425 case CODESYS_ISO2022:
|
|
|
2426 decode_coding_iso2022 (decoding, src, dst, n);
|
|
|
2427 break;
|
|
|
2428 #endif /* MULE */
|
|
|
2429 default:
|
|
|
2430 abort ();
|
|
|
2431 }
|
|
|
2432 }
|
|
|
2433
|
|
|
2434 DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /*
|
|
|
2435 Decode the text between START and END which is encoded in CODING-SYSTEM.
|
|
|
2436 This is useful if you've read in encoded text from a file without decoding
|
|
|
2437 it (e.g. you read in a JIS-formatted file but used the `binary' or
|
|
|
2438 `no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B").
|
|
|
2439 Return length of decoded text.
|
|
|
2440 BUFFER defaults to the current buffer if unspecified.
|
|
|
2441 */
|
|
|
2442 (start, end, coding_system, buffer))
|
|
|
2443 {
|
|
|
2444 Bufpos b, e;
|
|
|
2445 struct buffer *buf = decode_buffer (buffer, 0);
|
|
|
2446 Lisp_Object instream, lb_outstream, de_outstream, outstream;
|
|
|
2447 Lstream *istr, *ostr;
|
|
|
2448 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
|
2449
|
|
|
2450 get_buffer_range_char (buf, start, end, &b, &e, 0);
|
|
|
2451
|
|
|
2452 barf_if_buffer_read_only (buf, b, e);
|
|
|
2453
|
|
|
2454 coding_system = Fget_coding_system (coding_system);
|
|
|
2455 instream = make_lisp_buffer_input_stream (buf, b, e, 0);
|
|
|
2456 lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
|
|
|
2457 de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
|
|
|
2458 coding_system);
|
|
|
2459 outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
|
|
|
2460 Fget_coding_system (Qbinary));
|
|
|
2461 istr = XLSTREAM (instream);
|
|
|
2462 ostr = XLSTREAM (outstream);
|
|
|
2463 GCPRO4 (instream, lb_outstream, de_outstream, outstream);
|
|
|
2464
|
|
|
2465 /* The chain of streams looks like this:
|
|
|
2466
|
|
|
2467 [BUFFER] <----- send through
|
|
|
2468 ------> [ENCODE AS BINARY]
|
|
|
2469 ------> [DECODE AS SPECIFIED]
|
|
|
2470 ------> [BUFFER]
|
|
|
2471 */
|
|
|
2472
|
|
|
2473 while (1)
|
|
|
2474 {
|
|
|
2475 char tempbuf[1024]; /* some random amount */
|
|
|
2476 Bufpos newpos, even_newer_pos;
|
|
|
2477 Bufpos oldpos = lisp_buffer_stream_startpos (istr);
|
|
462
|
2478 Lstream_data_count size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
|
|
428
|
2479
|
|
|
2480 if (!size_in_bytes)
|
|
|
2481 break;
|
|
|
2482 newpos = lisp_buffer_stream_startpos (istr);
|
|
|
2483 Lstream_write (ostr, tempbuf, size_in_bytes);
|
|
|
2484 even_newer_pos = lisp_buffer_stream_startpos (istr);
|
|
|
2485 buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
|
|
|
2486 even_newer_pos, 0);
|
|
|
2487 }
|
|
|
2488 Lstream_close (istr);
|
|
|
2489 Lstream_close (ostr);
|
|
|
2490 UNGCPRO;
|
|
|
2491 Lstream_delete (istr);
|
|
|
2492 Lstream_delete (ostr);
|
|
|
2493 Lstream_delete (XLSTREAM (de_outstream));
|
|
|
2494 Lstream_delete (XLSTREAM (lb_outstream));
|
|
|
2495 return Qnil;
|
|
|
2496 }
|
|
|
2497
|
|
|
2498
|
|
|
2499 /************************************************************************/
|
|
|
2500 /* Converting to an external encoding ("encoding") */
|
|
|
2501 /************************************************************************/
|
|
|
2502
|
|
|
2503 /* An encoding stream is an output stream. When you create the
|
|
|
2504 stream, you specify the coding system that governs the encoding
|
|
|
2505 and another stream that the resulting encoded data is to be
|
|
|
2506 sent to, and then start sending data to it. */
|
|
|
2507
|
|
|
2508 #define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding)
|
|
|
2509
|
|
|
2510 struct encoding_stream
|
|
|
2511 {
|
|
|
2512 /* Coding system that governs the conversion. */
|
|
|
2513 Lisp_Coding_System *codesys;
|
|
|
2514
|
|
|
2515 /* Stream that we read the encoded data from or
|
|
|
2516 write the decoded data to. */
|
|
|
2517 Lstream *other_end;
|
|
|
2518
|
|
|
2519 /* If we are reading, then we can return only a fixed amount of
|
|
|
2520 data, so if the conversion resulted in too much data, we store it
|
|
|
2521 here for retrieval the next time around. */
|
|
|
2522 unsigned_char_dynarr *runoff;
|
|
|
2523
|
|
|
2524 /* FLAGS holds flags indicating the current state of the encoding.
|
|
|
2525 Some of these flags are dependent on the coding system. */
|
|
|
2526 unsigned int flags;
|
|
|
2527
|
|
|
2528 /* CH holds a partially built-up character. Since we only deal
|
|
|
2529 with one- and two-byte characters at the moment, we only use
|
|
|
2530 this to store the first byte of a two-byte character. */
|
|
|
2531 unsigned int ch;
|
|
|
2532 #ifdef MULE
|
|
|
2533 /* Additional information used by the ISO2022 encoder. */
|
|
|
2534 struct
|
|
|
2535 {
|
|
|
2536 /* CHARSET holds the character sets currently assigned to the G0
|
|
|
2537 through G3 registers. It is initialized from the array
|
|
|
2538 INITIAL_CHARSET in CODESYS. */
|
|
|
2539 Lisp_Object charset[4];
|
|
|
2540
|
|
|
2541 /* Which registers are currently invoked into the left (GL) and
|
|
|
2542 right (GR) halves of the 8-bit encoding space? */
|
|
|
2543 int register_left, register_right;
|
|
|
2544
|
|
|
2545 /* Whether we need to explicitly designate the charset in the
|
|
|
2546 G? register before using it. It is initialized from the
|
|
|
2547 array FORCE_CHARSET_ON_OUTPUT in CODESYS. */
|
|
|
2548 unsigned char force_charset_on_output[4];
|
|
|
2549
|
|
|
2550 /* Other state variables that need to be preserved across
|
|
|
2551 invocations. */
|
|
|
2552 Lisp_Object current_charset;
|
|
|
2553 int current_half;
|
|
|
2554 int current_char_boundary;
|
|
|
2555 } iso2022;
|
|
|
2556
|
|
|
2557 /* Additional information (the state of the running CCL program)
|
|
|
2558 used by the CCL encoder. */
|
|
|
2559 struct ccl_program ccl;
|
|
|
2560 #endif /* MULE */
|
|
|
2561 };
|
|
|
2562
|
|
462
|
2563 static Lstream_data_count encoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size);
|
|
|
2564 static Lstream_data_count encoding_writer (Lstream *stream, const unsigned char *data,
|
|
|
2565 Lstream_data_count size);
|
|
428
|
2566 static int encoding_rewinder (Lstream *stream);
|
|
|
2567 static int encoding_seekable_p (Lstream *stream);
|
|
|
2568 static int encoding_flusher (Lstream *stream);
|
|
|
2569 static int encoding_closer (Lstream *stream);
|
|
|
2570
|
|
|
2571 static Lisp_Object encoding_marker (Lisp_Object stream);
|
|
|
2572
|
|
|
2573 DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding,
|
|
|
2574 sizeof (struct encoding_stream));
|
|
|
2575
|
|
|
2576 static Lisp_Object
|
|
|
2577 encoding_marker (Lisp_Object stream)
|
|
|
2578 {
|
|
|
2579 Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end;
|
|
|
2580 Lisp_Object str_obj;
|
|
|
2581
|
|
|
2582 /* We do not need to mark the coding systems or charsets stored
|
|
|
2583 within the stream because they are stored in a global list
|
|
|
2584 and automatically marked. */
|
|
|
2585
|
|
|
2586 XSETLSTREAM (str_obj, str);
|
|
|
2587 mark_object (str_obj);
|
|
|
2588 if (str->imp->marker)
|
|
|
2589 return (str->imp->marker) (str_obj);
|
|
|
2590 else
|
|
|
2591 return Qnil;
|
|
|
2592 }
|
|
|
2593
|
|
|
2594 /* Read SIZE bytes of data and store it into DATA. We are a encoding stream
|
|
|
2595 so we read data from the other end, encode it, and store it into DATA. */
|
|
|
2596
|
|
462
|
2597 static Lstream_data_count
|
|
|
2598 encoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
|
|
428
|
2599 {
|
|
|
2600 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2601 unsigned char *orig_data = data;
|
|
462
|
2602 Lstream_data_count read_size;
|
|
428
|
2603 int error_occurred = 0;
|
|
|
2604
|
|
|
2605 /* We need to interface to mule_encode(), which expects to take some
|
|
|
2606 amount of data and store the result into a Dynarr. We have
|
|
|
2607 mule_encode() store into str->runoff, and take data from there
|
|
|
2608 as necessary. */
|
|
|
2609
|
|
|
2610 /* We loop until we have enough data, reading chunks from the other
|
|
|
2611 end and encoding it. */
|
|
|
2612 while (1)
|
|
|
2613 {
|
|
|
2614 /* Take data from the runoff if we can. Make sure to take at
|
|
|
2615 most SIZE bytes, and delete the data from the runoff. */
|
|
|
2616 if (Dynarr_length (str->runoff) > 0)
|
|
|
2617 {
|
|
|
2618 int chunk = min ((int) size, Dynarr_length (str->runoff));
|
|
|
2619 memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
|
|
|
2620 Dynarr_delete_many (str->runoff, 0, chunk);
|
|
|
2621 data += chunk;
|
|
|
2622 size -= chunk;
|
|
|
2623 }
|
|
|
2624
|
|
|
2625 if (size == 0)
|
|
|
2626 break; /* No more room for data */
|
|
|
2627
|
|
|
2628 if (str->flags & CODING_STATE_END)
|
|
|
2629 /* This means that on the previous iteration, we hit the EOF on
|
|
|
2630 the other end. We loop once more so that mule_encode() can
|
|
|
2631 output any final stuff it may be holding, or any "go back
|
|
|
2632 to a sane state" escape sequences. (This latter makes sense
|
|
|
2633 during encoding.) */
|
|
|
2634 break;
|
|
|
2635
|
|
|
2636 /* Exhausted the runoff, so get some more. DATA at least SIZE bytes
|
|
|
2637 left of storage in it, so it's OK to read directly into it.
|
|
|
2638 (We'll be overwriting above, after we've encoded it into the
|
|
|
2639 runoff.) */
|
|
|
2640 read_size = Lstream_read (str->other_end, data, size);
|
|
|
2641 if (read_size < 0)
|
|
|
2642 {
|
|
|
2643 error_occurred = 1;
|
|
|
2644 break;
|
|
|
2645 }
|
|
|
2646 if (read_size == 0)
|
|
|
2647 /* There might be some more end data produced in the translation.
|
|
|
2648 See the comment above. */
|
|
|
2649 str->flags |= CODING_STATE_END;
|
|
|
2650 mule_encode (stream, data, str->runoff, read_size);
|
|
|
2651 }
|
|
|
2652
|
|
|
2653 if (data == orig_data)
|
|
|
2654 return error_occurred ? -1 : 0;
|
|
|
2655 else
|
|
|
2656 return data - orig_data;
|
|
|
2657 }
|
|
|
2658
|
|
462
|
2659 static Lstream_data_count
|
|
|
2660 encoding_writer (Lstream *stream, const unsigned char *data, Lstream_data_count size)
|
|
428
|
2661 {
|
|
|
2662 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
462
|
2663 Lstream_data_count retval;
|
|
428
|
2664
|
|
|
2665 /* Encode all our data into the runoff, and then attempt to write
|
|
|
2666 it all out to the other end. Remove whatever chunk we succeeded
|
|
|
2667 in writing. */
|
|
|
2668 mule_encode (stream, data, str->runoff, size);
|
|
|
2669 retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
|
|
|
2670 Dynarr_length (str->runoff));
|
|
|
2671 if (retval > 0)
|
|
|
2672 Dynarr_delete_many (str->runoff, 0, retval);
|
|
|
2673 /* Do NOT return retval. The return value indicates how much
|
|
|
2674 of the incoming data was written, not how many bytes were
|
|
|
2675 written. */
|
|
|
2676 return size;
|
|
|
2677 }
|
|
|
2678
|
|
|
2679 static void
|
|
|
2680 reset_encoding_stream (struct encoding_stream *str)
|
|
|
2681 {
|
|
|
2682 #ifdef MULE
|
|
|
2683 switch (CODING_SYSTEM_TYPE (str->codesys))
|
|
|
2684 {
|
|
|
2685 case CODESYS_ISO2022:
|
|
|
2686 {
|
|
|
2687 int i;
|
|
|
2688
|
|
|
2689 for (i = 0; i < 4; i++)
|
|
|
2690 {
|
|
|
2691 str->iso2022.charset[i] =
|
|
|
2692 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i);
|
|
|
2693 str->iso2022.force_charset_on_output[i] =
|
|
|
2694 CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i);
|
|
|
2695 }
|
|
|
2696 str->iso2022.register_left = 0;
|
|
|
2697 str->iso2022.register_right = 1;
|
|
|
2698 str->iso2022.current_charset = Qnil;
|
|
|
2699 str->iso2022.current_half = 0;
|
|
|
2700 str->iso2022.current_char_boundary = 1;
|
|
|
2701 break;
|
|
|
2702 }
|
|
|
2703 case CODESYS_CCL:
|
|
|
2704 setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys));
|
|
|
2705 break;
|
|
|
2706 default:
|
|
|
2707 break;
|
|
|
2708 }
|
|
|
2709 #endif /* MULE */
|
|
|
2710
|
|
|
2711 str->flags = str->ch = 0;
|
|
|
2712 }
|
|
|
2713
|
|
|
2714 static int
|
|
|
2715 encoding_rewinder (Lstream *stream)
|
|
|
2716 {
|
|
|
2717 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2718 reset_encoding_stream (str);
|
|
|
2719 Dynarr_reset (str->runoff);
|
|
|
2720 return Lstream_rewind (str->other_end);
|
|
|
2721 }
|
|
|
2722
|
|
|
2723 static int
|
|
|
2724 encoding_seekable_p (Lstream *stream)
|
|
|
2725 {
|
|
|
2726 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2727 return Lstream_seekable_p (str->other_end);
|
|
|
2728 }
|
|
|
2729
|
|
|
2730 static int
|
|
|
2731 encoding_flusher (Lstream *stream)
|
|
|
2732 {
|
|
|
2733 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2734 return Lstream_flush (str->other_end);
|
|
|
2735 }
|
|
|
2736
|
|
|
2737 static int
|
|
|
2738 encoding_closer (Lstream *stream)
|
|
|
2739 {
|
|
|
2740 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2741 if (stream->flags & LSTREAM_FL_WRITE)
|
|
|
2742 {
|
|
|
2743 str->flags |= CODING_STATE_END;
|
|
|
2744 encoding_writer (stream, 0, 0);
|
|
|
2745 }
|
|
|
2746 Dynarr_free (str->runoff);
|
|
|
2747 return Lstream_close (str->other_end);
|
|
|
2748 }
|
|
|
2749
|
|
|
2750 Lisp_Object
|
|
|
2751 encoding_stream_coding_system (Lstream *stream)
|
|
|
2752 {
|
|
|
2753 Lisp_Object coding_system;
|
|
|
2754 struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
|
|
|
2755
|
|
|
2756 XSETCODING_SYSTEM (coding_system, str->codesys);
|
|
|
2757 return coding_system;
|
|
|
2758 }
|
|
|
2759
|
|
|
2760 void
|
|
|
2761 set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
|
|
|
2762 {
|
|
|
2763 Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
|
|
|
2764 struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
|
|
|
2765 str->codesys = cs;
|
|
|
2766 reset_encoding_stream (str);
|
|
|
2767 }
|
|
|
2768
|
|
|
2769 static Lisp_Object
|
|
|
2770 make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys,
|
|
442
|
2771 const char *mode)
|
|
428
|
2772 {
|
|
|
2773 Lstream *lstr = Lstream_new (lstream_encoding, mode);
|
|
|
2774 struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
|
|
|
2775 Lisp_Object obj;
|
|
|
2776
|
|
|
2777 xzero (*str);
|
|
|
2778 str->runoff = Dynarr_new (unsigned_char);
|
|
|
2779 str->other_end = stream;
|
|
|
2780 set_encoding_stream_coding_system (lstr, codesys);
|
|
|
2781 XSETLSTREAM (obj, lstr);
|
|
|
2782 return obj;
|
|
|
2783 }
|
|
|
2784
|
|
|
2785 Lisp_Object
|
|
|
2786 make_encoding_input_stream (Lstream *stream, Lisp_Object codesys)
|
|
|
2787 {
|
|
|
2788 return make_encoding_stream_1 (stream, codesys, "r");
|
|
|
2789 }
|
|
|
2790
|
|
|
2791 Lisp_Object
|
|
|
2792 make_encoding_output_stream (Lstream *stream, Lisp_Object codesys)
|
|
|
2793 {
|
|
|
2794 return make_encoding_stream_1 (stream, codesys, "w");
|
|
|
2795 }
|
|
|
2796
|
|
|
2797 /* Convert N bytes of internally-formatted data stored in SRC to an
|
|
|
2798 external format, according to the encoding stream ENCODING.
|
|
|
2799 Store the encoded data into DST. */
|
|
|
2800
|
|
|
2801 static void
|
|
444
|
2802 mule_encode (Lstream *encoding, const Bufbyte *src,
|
|
462
|
2803 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
2804 {
|
|
|
2805 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
2806
|
|
|
2807 switch (CODING_SYSTEM_TYPE (str->codesys))
|
|
|
2808 {
|
|
|
2809 #ifdef DEBUG_XEMACS
|
|
|
2810 case CODESYS_INTERNAL:
|
|
|
2811 Dynarr_add_many (dst, src, n);
|
|
|
2812 break;
|
|
|
2813 #endif
|
|
|
2814 case CODESYS_AUTODETECT:
|
|
|
2815 /* If we got this far and still haven't decided on the coding
|
|
|
2816 system, then do no conversion. */
|
|
|
2817 case CODESYS_NO_CONVERSION:
|
|
|
2818 encode_coding_no_conversion (encoding, src, dst, n);
|
|
|
2819 break;
|
|
|
2820 #ifdef MULE
|
|
|
2821 case CODESYS_SHIFT_JIS:
|
|
|
2822 encode_coding_sjis (encoding, src, dst, n);
|
|
|
2823 break;
|
|
|
2824 case CODESYS_BIG5:
|
|
|
2825 encode_coding_big5 (encoding, src, dst, n);
|
|
|
2826 break;
|
|
|
2827 case CODESYS_UCS4:
|
|
|
2828 encode_coding_ucs4 (encoding, src, dst, n);
|
|
|
2829 break;
|
|
|
2830 case CODESYS_UTF8:
|
|
|
2831 encode_coding_utf8 (encoding, src, dst, n);
|
|
|
2832 break;
|
|
|
2833 case CODESYS_CCL:
|
|
|
2834 str->ccl.last_block = str->flags & CODING_STATE_END;
|
|
444
|
2835 /* When applying ccl program to stream, MUST NOT set NULL
|
|
|
2836 pointer to src. */
|
|
|
2837 ccl_driver (&str->ccl, ((src) ? src : (unsigned char*)""),
|
|
|
2838 dst, n, 0, CCL_MODE_ENCODING);
|
|
428
|
2839 break;
|
|
|
2840 case CODESYS_ISO2022:
|
|
|
2841 encode_coding_iso2022 (encoding, src, dst, n);
|
|
|
2842 break;
|
|
|
2843 #endif /* MULE */
|
|
|
2844 default:
|
|
|
2845 abort ();
|
|
|
2846 }
|
|
|
2847 }
|
|
|
2848
|
|
|
2849 DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /*
|
|
|
2850 Encode the text between START and END using CODING-SYSTEM.
|
|
|
2851 This will, for example, convert Japanese characters into stuff such as
|
|
|
2852 "^[$B!<!+^[(B" if you use the JIS encoding. Return length of encoded
|
|
|
2853 text. BUFFER defaults to the current buffer if unspecified.
|
|
|
2854 */
|
|
|
2855 (start, end, coding_system, buffer))
|
|
|
2856 {
|
|
|
2857 Bufpos b, e;
|
|
|
2858 struct buffer *buf = decode_buffer (buffer, 0);
|
|
|
2859 Lisp_Object instream, lb_outstream, de_outstream, outstream;
|
|
|
2860 Lstream *istr, *ostr;
|
|
|
2861 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
|
2862
|
|
|
2863 get_buffer_range_char (buf, start, end, &b, &e, 0);
|
|
|
2864
|
|
|
2865 barf_if_buffer_read_only (buf, b, e);
|
|
|
2866
|
|
|
2867 coding_system = Fget_coding_system (coding_system);
|
|
|
2868 instream = make_lisp_buffer_input_stream (buf, b, e, 0);
|
|
|
2869 lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
|
|
|
2870 de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
|
|
|
2871 Fget_coding_system (Qbinary));
|
|
|
2872 outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
|
|
|
2873 coding_system);
|
|
|
2874 istr = XLSTREAM (instream);
|
|
|
2875 ostr = XLSTREAM (outstream);
|
|
|
2876 GCPRO4 (instream, outstream, de_outstream, lb_outstream);
|
|
|
2877 /* The chain of streams looks like this:
|
|
|
2878
|
|
|
2879 [BUFFER] <----- send through
|
|
|
2880 ------> [ENCODE AS SPECIFIED]
|
|
|
2881 ------> [DECODE AS BINARY]
|
|
|
2882 ------> [BUFFER]
|
|
|
2883 */
|
|
|
2884 while (1)
|
|
|
2885 {
|
|
|
2886 char tempbuf[1024]; /* some random amount */
|
|
|
2887 Bufpos newpos, even_newer_pos;
|
|
|
2888 Bufpos oldpos = lisp_buffer_stream_startpos (istr);
|
|
462
|
2889 Lstream_data_count size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
|
|
428
|
2890
|
|
|
2891 if (!size_in_bytes)
|
|
|
2892 break;
|
|
|
2893 newpos = lisp_buffer_stream_startpos (istr);
|
|
|
2894 Lstream_write (ostr, tempbuf, size_in_bytes);
|
|
|
2895 even_newer_pos = lisp_buffer_stream_startpos (istr);
|
|
|
2896 buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
|
|
|
2897 even_newer_pos, 0);
|
|
|
2898 }
|
|
|
2899
|
|
|
2900 {
|
|
|
2901 Charcount retlen =
|
|
|
2902 lisp_buffer_stream_startpos (XLSTREAM (instream)) - b;
|
|
|
2903 Lstream_close (istr);
|
|
|
2904 Lstream_close (ostr);
|
|
|
2905 UNGCPRO;
|
|
|
2906 Lstream_delete (istr);
|
|
|
2907 Lstream_delete (ostr);
|
|
|
2908 Lstream_delete (XLSTREAM (de_outstream));
|
|
|
2909 Lstream_delete (XLSTREAM (lb_outstream));
|
|
|
2910 return make_int (retlen);
|
|
|
2911 }
|
|
|
2912 }
|
|
|
2913
|
|
|
2914 #ifdef MULE
|
|
|
2915
|
|
|
2916 /************************************************************************/
|
|
|
2917 /* Shift-JIS methods */
|
|
|
2918 /************************************************************************/
|
|
|
2919
|
|
|
2920 /* Shift-JIS is a coding system encoding three character sets: ASCII, right
|
|
|
2921 half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
|
|
|
2922 as is. A character of JISX0201-Kana (DIMENSION1_CHARS94 character set) is
|
|
|
2923 encoded by "position-code + 0x80". A character of JISX0208
|
|
|
2924 (DIMENSION2_CHARS94 character set) is encoded in 2-byte but two
|
|
|
2925 position-codes are divided and shifted so that it fit in the range
|
|
|
2926 below.
|
|
|
2927
|
|
|
2928 --- CODE RANGE of Shift-JIS ---
|
|
|
2929 (character set) (range)
|
|
|
2930 ASCII 0x00 .. 0x7F
|
|
|
2931 JISX0201-Kana 0xA0 .. 0xDF
|
|
|
2932 JISX0208 (1st byte) 0x80 .. 0x9F and 0xE0 .. 0xEF
|
|
|
2933 (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
|
|
|
2934 -------------------------------
|
|
|
2935
|
|
|
2936 */
|
|
|
2937
|
|
|
2938 /* Is this the first byte of a Shift-JIS two-byte char? */
|
|
|
2939
|
|
|
2940 #define BYTE_SJIS_TWO_BYTE_1_P(c) \
|
|
|
2941 (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF))
|
|
|
2942
|
|
|
2943 /* Is this the second byte of a Shift-JIS two-byte char? */
|
|
|
2944
|
|
|
2945 #define BYTE_SJIS_TWO_BYTE_2_P(c) \
|
|
|
2946 (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC))
|
|
|
2947
|
|
|
2948 #define BYTE_SJIS_KATAKANA_P(c) \
|
|
|
2949 ((c) >= 0xA1 && (c) <= 0xDF)
|
|
|
2950
|
|
|
2951 static int
|
|
462
|
2952 detect_coding_sjis (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
|
|
428
|
2953 {
|
|
|
2954 while (n--)
|
|
|
2955 {
|
|
444
|
2956 unsigned char c = *(unsigned char *)src++;
|
|
428
|
2957 if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
|
|
|
2958 return 0;
|
|
|
2959 if (st->shift_jis.in_second_byte)
|
|
|
2960 {
|
|
|
2961 st->shift_jis.in_second_byte = 0;
|
|
|
2962 if (c < 0x40)
|
|
|
2963 return 0;
|
|
|
2964 }
|
|
|
2965 else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
|
|
|
2966 st->shift_jis.in_second_byte = 1;
|
|
|
2967 }
|
|
|
2968 return CODING_CATEGORY_SHIFT_JIS_MASK;
|
|
|
2969 }
|
|
|
2970
|
|
|
2971 /* Convert Shift-JIS data to internal format. */
|
|
|
2972
|
|
|
2973 static void
|
|
444
|
2974 decode_coding_sjis (Lstream *decoding, const Extbyte *src,
|
|
462
|
2975 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
2976 {
|
|
|
2977 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
2978 unsigned int flags = str->flags;
|
|
|
2979 unsigned int ch = str->ch;
|
|
|
2980 eol_type_t eol_type = str->eol_type;
|
|
|
2981
|
|
|
2982 while (n--)
|
|
|
2983 {
|
|
444
|
2984 unsigned char c = *(unsigned char *)src++;
|
|
428
|
2985
|
|
|
2986 if (ch)
|
|
|
2987 {
|
|
|
2988 /* Previous character was first byte of Shift-JIS Kanji char. */
|
|
|
2989 if (BYTE_SJIS_TWO_BYTE_2_P (c))
|
|
|
2990 {
|
|
|
2991 unsigned char e1, e2;
|
|
|
2992
|
|
|
2993 Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
|
|
|
2994 DECODE_SJIS (ch, c, e1, e2);
|
|
|
2995 Dynarr_add (dst, e1);
|
|
|
2996 Dynarr_add (dst, e2);
|
|
|
2997 }
|
|
|
2998 else
|
|
|
2999 {
|
|
|
3000 DECODE_ADD_BINARY_CHAR (ch, dst);
|
|
|
3001 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
3002 }
|
|
|
3003 ch = 0;
|
|
|
3004 }
|
|
|
3005 else
|
|
|
3006 {
|
|
|
3007 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
3008 if (BYTE_SJIS_TWO_BYTE_1_P (c))
|
|
|
3009 ch = c;
|
|
|
3010 else if (BYTE_SJIS_KATAKANA_P (c))
|
|
|
3011 {
|
|
|
3012 Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201);
|
|
|
3013 Dynarr_add (dst, c);
|
|
|
3014 }
|
|
|
3015 else
|
|
|
3016 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
3017 }
|
|
|
3018 label_continue_loop:;
|
|
|
3019 }
|
|
|
3020
|
|
|
3021 DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
|
|
|
3022
|
|
|
3023 str->flags = flags;
|
|
|
3024 str->ch = ch;
|
|
|
3025 }
|
|
|
3026
|
|
|
3027 /* Convert internally-formatted data to Shift-JIS. */
|
|
|
3028
|
|
|
3029 static void
|
|
444
|
3030 encode_coding_sjis (Lstream *encoding, const Bufbyte *src,
|
|
462
|
3031 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3032 {
|
|
|
3033 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
3034 unsigned int flags = str->flags;
|
|
|
3035 unsigned int ch = str->ch;
|
|
|
3036 eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
|
|
|
3037
|
|
|
3038 while (n--)
|
|
|
3039 {
|
|
444
|
3040 Bufbyte c = *src++;
|
|
428
|
3041 if (c == '\n')
|
|
|
3042 {
|
|
|
3043 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
|
|
|
3044 Dynarr_add (dst, '\r');
|
|
|
3045 if (eol_type != EOL_CR)
|
|
|
3046 Dynarr_add (dst, '\n');
|
|
|
3047 ch = 0;
|
|
|
3048 }
|
|
|
3049 else if (BYTE_ASCII_P (c))
|
|
|
3050 {
|
|
|
3051 Dynarr_add (dst, c);
|
|
|
3052 ch = 0;
|
|
|
3053 }
|
|
|
3054 else if (BUFBYTE_LEADING_BYTE_P (c))
|
|
|
3055 ch = (c == LEADING_BYTE_KATAKANA_JISX0201 ||
|
|
|
3056 c == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
|
|
|
3057 c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0;
|
|
|
3058 else if (ch)
|
|
|
3059 {
|
|
|
3060 if (ch == LEADING_BYTE_KATAKANA_JISX0201)
|
|
|
3061 {
|
|
|
3062 Dynarr_add (dst, c);
|
|
|
3063 ch = 0;
|
|
|
3064 }
|
|
|
3065 else if (ch == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
|
|
|
3066 ch == LEADING_BYTE_JAPANESE_JISX0208)
|
|
|
3067 ch = c;
|
|
|
3068 else
|
|
|
3069 {
|
|
|
3070 unsigned char j1, j2;
|
|
|
3071 ENCODE_SJIS (ch, c, j1, j2);
|
|
|
3072 Dynarr_add (dst, j1);
|
|
|
3073 Dynarr_add (dst, j2);
|
|
|
3074 ch = 0;
|
|
|
3075 }
|
|
|
3076 }
|
|
|
3077 }
|
|
|
3078
|
|
|
3079 str->flags = flags;
|
|
|
3080 str->ch = ch;
|
|
|
3081 }
|
|
|
3082
|
|
|
3083 DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /*
|
|
|
3084 Decode a JISX0208 character of Shift-JIS coding-system.
|
|
|
3085 CODE is the character code in Shift-JIS as a cons of type bytes.
|
|
|
3086 Return the corresponding character.
|
|
|
3087 */
|
|
|
3088 (code))
|
|
|
3089 {
|
|
|
3090 unsigned char c1, c2, s1, s2;
|
|
|
3091
|
|
|
3092 CHECK_CONS (code);
|
|
|
3093 CHECK_INT (XCAR (code));
|
|
|
3094 CHECK_INT (XCDR (code));
|
|
|
3095 s1 = XINT (XCAR (code));
|
|
|
3096 s2 = XINT (XCDR (code));
|
|
|
3097 if (BYTE_SJIS_TWO_BYTE_1_P (s1) &&
|
|
|
3098 BYTE_SJIS_TWO_BYTE_2_P (s2))
|
|
|
3099 {
|
|
|
3100 DECODE_SJIS (s1, s2, c1, c2);
|
|
|
3101 return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208,
|
|
|
3102 c1 & 0x7F, c2 & 0x7F));
|
|
|
3103 }
|
|
|
3104 else
|
|
|
3105 return Qnil;
|
|
|
3106 }
|
|
|
3107
|
|
|
3108 DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /*
|
|
444
|
3109 Encode a JISX0208 character CHARACTER to SHIFT-JIS coding-system.
|
|
428
|
3110 Return the corresponding character code in SHIFT-JIS as a cons of two bytes.
|
|
|
3111 */
|
|
444
|
3112 (character))
|
|
428
|
3113 {
|
|
|
3114 Lisp_Object charset;
|
|
|
3115 int c1, c2, s1, s2;
|
|
|
3116
|
|
444
|
3117 CHECK_CHAR_COERCE_INT (character);
|
|
|
3118 BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
|
|
428
|
3119 if (EQ (charset, Vcharset_japanese_jisx0208))
|
|
|
3120 {
|
|
|
3121 ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
|
|
|
3122 return Fcons (make_int (s1), make_int (s2));
|
|
|
3123 }
|
|
|
3124 else
|
|
|
3125 return Qnil;
|
|
|
3126 }
|
|
|
3127
|
|
|
3128
|
|
|
3129 /************************************************************************/
|
|
|
3130 /* Big5 methods */
|
|
|
3131 /************************************************************************/
|
|
|
3132
|
|
|
3133 /* BIG5 is a coding system encoding two character sets: ASCII and
|
|
|
3134 Big5. An ASCII character is encoded as is. Big5 is a two-byte
|
|
|
3135 character set and is encoded in two-byte.
|
|
|
3136
|
|
|
3137 --- CODE RANGE of BIG5 ---
|
|
|
3138 (character set) (range)
|
|
|
3139 ASCII 0x00 .. 0x7F
|
|
|
3140 Big5 (1st byte) 0xA1 .. 0xFE
|
|
|
3141 (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
|
|
|
3142 --------------------------
|
|
|
3143
|
|
|
3144 Since the number of characters in Big5 is larger than maximum
|
|
|
3145 characters in Emacs' charset (96x96), it can't be handled as one
|
|
|
3146 charset. So, in Emacs, Big5 is divided into two: `charset-big5-1'
|
|
|
3147 and `charset-big5-2'. Both <type>s are DIMENSION2_CHARS94. The former
|
|
|
3148 contains frequently used characters and the latter contains less
|
|
|
3149 frequently used characters. */
|
|
|
3150
|
|
|
3151 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
|
|
|
3152 ((c) >= 0xA1 && (c) <= 0xFE)
|
|
|
3153
|
|
|
3154 /* Is this the second byte of a Shift-JIS two-byte char? */
|
|
|
3155
|
|
|
3156 #define BYTE_BIG5_TWO_BYTE_2_P(c) \
|
|
|
3157 (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE))
|
|
|
3158
|
|
|
3159 /* Number of Big5 characters which have the same code in 1st byte. */
|
|
|
3160
|
|
|
3161 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
|
|
|
3162
|
|
|
3163 /* Code conversion macros. These are macros because they are used in
|
|
|
3164 inner loops during code conversion.
|
|
|
3165
|
|
|
3166 Note that temporary variables in macros introduce the classic
|
|
|
3167 dynamic-scoping problems with variable names. We use capital-
|
|
|
3168 lettered variables in the assumption that XEmacs does not use
|
|
|
3169 capital letters in variables except in a very formalized way
|
|
|
3170 (e.g. Qstring). */
|
|
|
3171
|
|
|
3172 /* Convert Big5 code (b1, b2) into its internal string representation
|
|
|
3173 (lb, c1, c2). */
|
|
|
3174
|
|
|
3175 /* There is a much simpler way to split the Big5 charset into two.
|
|
|
3176 For the moment I'm going to leave the algorithm as-is because it
|
|
|
3177 claims to separate out the most-used characters into a single
|
|
|
3178 charset, which perhaps will lead to optimizations in various
|
|
|
3179 places.
|
|
|
3180
|
|
|
3181 The way the algorithm works is something like this:
|
|
|
3182
|
|
|
3183 Big5 can be viewed as a 94x157 charset, where the row is
|
|
|
3184 encoded into the bytes 0xA1 .. 0xFE and the column is encoded
|
|
|
3185 into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE. As for frequency,
|
|
|
3186 the split between low and high column numbers is apparently
|
|
|
3187 meaningless; ascending rows produce less and less frequent chars.
|
|
|
3188 Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to
|
|
|
3189 the first charset, and the upper half (0xC9 .. 0xFE) to the
|
|
|
3190 second. To do the conversion, we convert the character into
|
|
|
3191 a single number where 0 .. 156 is the first row, 157 .. 313
|
|
|
3192 is the second, etc. That way, the characters are ordered by
|
|
|
3193 decreasing frequency. Then we just chop the space in two
|
|
|
3194 and coerce the result into a 94x94 space.
|
|
|
3195 */
|
|
|
3196
|
|
|
3197 #define DECODE_BIG5(b1, b2, lb, c1, c2) do \
|
|
|
3198 { \
|
|
|
3199 int B1 = b1, B2 = b2; \
|
|
|
3200 unsigned int I \
|
|
|
3201 = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62); \
|
|
|
3202 \
|
|
|
3203 if (B1 < 0xC9) \
|
|
|
3204 { \
|
|
|
3205 lb = LEADING_BYTE_CHINESE_BIG5_1; \
|
|
|
3206 } \
|
|
|
3207 else \
|
|
|
3208 { \
|
|
|
3209 lb = LEADING_BYTE_CHINESE_BIG5_2; \
|
|
|
3210 I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1); \
|
|
|
3211 } \
|
|
|
3212 c1 = I / (0xFF - 0xA1) + 0xA1; \
|
|
|
3213 c2 = I % (0xFF - 0xA1) + 0xA1; \
|
|
|
3214 } while (0)
|
|
|
3215
|
|
|
3216 /* Convert the internal string representation of a Big5 character
|
|
|
3217 (lb, c1, c2) into Big5 code (b1, b2). */
|
|
|
3218
|
|
|
3219 #define ENCODE_BIG5(lb, c1, c2, b1, b2) do \
|
|
|
3220 { \
|
|
|
3221 unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1); \
|
|
|
3222 \
|
|
|
3223 if (lb == LEADING_BYTE_CHINESE_BIG5_2) \
|
|
|
3224 { \
|
|
|
3225 I += BIG5_SAME_ROW * (0xC9 - 0xA1); \
|
|
|
3226 } \
|
|
|
3227 b1 = I / BIG5_SAME_ROW + 0xA1; \
|
|
|
3228 b2 = I % BIG5_SAME_ROW; \
|
|
|
3229 b2 += b2 < 0x3F ? 0x40 : 0x62; \
|
|
|
3230 } while (0)
|
|
|
3231
|
|
|
3232 static int
|
|
462
|
3233 detect_coding_big5 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
|
|
428
|
3234 {
|
|
|
3235 while (n--)
|
|
|
3236 {
|
|
444
|
3237 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3238 if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO ||
|
|
|
3239 (c >= 0x80 && c <= 0xA0))
|
|
|
3240 return 0;
|
|
|
3241 if (st->big5.in_second_byte)
|
|
|
3242 {
|
|
|
3243 st->big5.in_second_byte = 0;
|
|
|
3244 if (c < 0x40 || (c >= 0x80 && c <= 0xA0))
|
|
|
3245 return 0;
|
|
|
3246 }
|
|
|
3247 else if (c >= 0xA1)
|
|
|
3248 st->big5.in_second_byte = 1;
|
|
|
3249 }
|
|
|
3250 return CODING_CATEGORY_BIG5_MASK;
|
|
|
3251 }
|
|
|
3252
|
|
|
3253 /* Convert Big5 data to internal format. */
|
|
|
3254
|
|
|
3255 static void
|
|
444
|
3256 decode_coding_big5 (Lstream *decoding, const Extbyte *src,
|
|
462
|
3257 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3258 {
|
|
|
3259 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
3260 unsigned int flags = str->flags;
|
|
|
3261 unsigned int ch = str->ch;
|
|
|
3262 eol_type_t eol_type = str->eol_type;
|
|
|
3263
|
|
|
3264 while (n--)
|
|
|
3265 {
|
|
444
|
3266 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3267 if (ch)
|
|
|
3268 {
|
|
|
3269 /* Previous character was first byte of Big5 char. */
|
|
|
3270 if (BYTE_BIG5_TWO_BYTE_2_P (c))
|
|
|
3271 {
|
|
|
3272 unsigned char b1, b2, b3;
|
|
|
3273 DECODE_BIG5 (ch, c, b1, b2, b3);
|
|
|
3274 Dynarr_add (dst, b1);
|
|
|
3275 Dynarr_add (dst, b2);
|
|
|
3276 Dynarr_add (dst, b3);
|
|
|
3277 }
|
|
|
3278 else
|
|
|
3279 {
|
|
|
3280 DECODE_ADD_BINARY_CHAR (ch, dst);
|
|
|
3281 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
3282 }
|
|
|
3283 ch = 0;
|
|
|
3284 }
|
|
|
3285 else
|
|
|
3286 {
|
|
|
3287 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
3288 if (BYTE_BIG5_TWO_BYTE_1_P (c))
|
|
|
3289 ch = c;
|
|
|
3290 else
|
|
|
3291 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
3292 }
|
|
|
3293 label_continue_loop:;
|
|
|
3294 }
|
|
|
3295
|
|
|
3296 DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
|
|
|
3297
|
|
|
3298 str->flags = flags;
|
|
|
3299 str->ch = ch;
|
|
|
3300 }
|
|
|
3301
|
|
|
3302 /* Convert internally-formatted data to Big5. */
|
|
|
3303
|
|
|
3304 static void
|
|
444
|
3305 encode_coding_big5 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
3306 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3307 {
|
|
|
3308 unsigned char c;
|
|
|
3309 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
3310 unsigned int flags = str->flags;
|
|
|
3311 unsigned int ch = str->ch;
|
|
|
3312 eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
|
|
|
3313
|
|
|
3314 while (n--)
|
|
|
3315 {
|
|
|
3316 c = *src++;
|
|
|
3317 if (c == '\n')
|
|
|
3318 {
|
|
|
3319 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
|
|
|
3320 Dynarr_add (dst, '\r');
|
|
|
3321 if (eol_type != EOL_CR)
|
|
|
3322 Dynarr_add (dst, '\n');
|
|
|
3323 }
|
|
|
3324 else if (BYTE_ASCII_P (c))
|
|
|
3325 {
|
|
|
3326 /* ASCII. */
|
|
|
3327 Dynarr_add (dst, c);
|
|
|
3328 }
|
|
|
3329 else if (BUFBYTE_LEADING_BYTE_P (c))
|
|
|
3330 {
|
|
|
3331 if (c == LEADING_BYTE_CHINESE_BIG5_1 ||
|
|
|
3332 c == LEADING_BYTE_CHINESE_BIG5_2)
|
|
|
3333 {
|
|
|
3334 /* A recognized leading byte. */
|
|
|
3335 ch = c;
|
|
|
3336 continue; /* not done with this character. */
|
|
|
3337 }
|
|
|
3338 /* otherwise just ignore this character. */
|
|
|
3339 }
|
|
|
3340 else if (ch == LEADING_BYTE_CHINESE_BIG5_1 ||
|
|
|
3341 ch == LEADING_BYTE_CHINESE_BIG5_2)
|
|
|
3342 {
|
|
|
3343 /* Previous char was a recognized leading byte. */
|
|
|
3344 ch = (ch << 8) | c;
|
|
|
3345 continue; /* not done with this character. */
|
|
|
3346 }
|
|
|
3347 else if (ch)
|
|
|
3348 {
|
|
|
3349 /* Encountering second byte of a Big5 character. */
|
|
|
3350 unsigned char b1, b2;
|
|
|
3351
|
|
|
3352 ENCODE_BIG5 (ch >> 8, ch & 0xFF, c, b1, b2);
|
|
|
3353 Dynarr_add (dst, b1);
|
|
|
3354 Dynarr_add (dst, b2);
|
|
|
3355 }
|
|
|
3356
|
|
|
3357 ch = 0;
|
|
|
3358 }
|
|
|
3359
|
|
|
3360 str->flags = flags;
|
|
|
3361 str->ch = ch;
|
|
|
3362 }
|
|
|
3363
|
|
|
3364
|
|
|
3365 DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /*
|
|
|
3366 Decode a Big5 character CODE of BIG5 coding-system.
|
|
|
3367 CODE is the character code in BIG5, a cons of two integers.
|
|
|
3368 Return the corresponding character.
|
|
|
3369 */
|
|
|
3370 (code))
|
|
|
3371 {
|
|
|
3372 unsigned char c1, c2, b1, b2;
|
|
|
3373
|
|
|
3374 CHECK_CONS (code);
|
|
|
3375 CHECK_INT (XCAR (code));
|
|
|
3376 CHECK_INT (XCDR (code));
|
|
|
3377 b1 = XINT (XCAR (code));
|
|
|
3378 b2 = XINT (XCDR (code));
|
|
|
3379 if (BYTE_BIG5_TWO_BYTE_1_P (b1) &&
|
|
|
3380 BYTE_BIG5_TWO_BYTE_2_P (b2))
|
|
|
3381 {
|
|
|
3382 int leading_byte;
|
|
|
3383 Lisp_Object charset;
|
|
|
3384 DECODE_BIG5 (b1, b2, leading_byte, c1, c2);
|
|
|
3385 charset = CHARSET_BY_LEADING_BYTE (leading_byte);
|
|
|
3386 return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F));
|
|
|
3387 }
|
|
|
3388 else
|
|
|
3389 return Qnil;
|
|
|
3390 }
|
|
|
3391
|
|
|
3392 DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /*
|
|
444
|
3393 Encode the Big5 character CHARACTER in the BIG5 coding-system.
|
|
428
|
3394 Return the corresponding character code in Big5.
|
|
|
3395 */
|
|
444
|
3396 (character))
|
|
428
|
3397 {
|
|
|
3398 Lisp_Object charset;
|
|
|
3399 int c1, c2, b1, b2;
|
|
|
3400
|
|
444
|
3401 CHECK_CHAR_COERCE_INT (character);
|
|
|
3402 BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
|
|
428
|
3403 if (EQ (charset, Vcharset_chinese_big5_1) ||
|
|
|
3404 EQ (charset, Vcharset_chinese_big5_2))
|
|
|
3405 {
|
|
|
3406 ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80,
|
|
|
3407 b1, b2);
|
|
|
3408 return Fcons (make_int (b1), make_int (b2));
|
|
|
3409 }
|
|
|
3410 else
|
|
|
3411 return Qnil;
|
|
|
3412 }
|
|
|
3413
|
|
|
3414
|
|
|
3415 /************************************************************************/
|
|
|
3416 /* UCS-4 methods */
|
|
|
3417 /* */
|
|
|
3418 /* UCS-4 character codes are implemented as nonnegative integers. */
|
|
|
3419 /* */
|
|
|
3420 /************************************************************************/
|
|
|
3421
|
|
|
3422
|
|
|
3423 DEFUN ("set-ucs-char", Fset_ucs_char, 2, 2, 0, /*
|
|
|
3424 Map UCS-4 code CODE to Mule character CHARACTER.
|
|
|
3425
|
|
|
3426 Return T on success, NIL on failure.
|
|
|
3427 */
|
|
|
3428 (code, character))
|
|
|
3429 {
|
|
442
|
3430 size_t c;
|
|
428
|
3431
|
|
|
3432 CHECK_CHAR (character);
|
|
442
|
3433 CHECK_NATNUM (code);
|
|
428
|
3434 c = XINT (code);
|
|
|
3435
|
|
442
|
3436 if (c < countof (fcd->ucs_to_mule_table))
|
|
428
|
3437 {
|
|
|
3438 fcd->ucs_to_mule_table[c] = character;
|
|
|
3439 return Qt;
|
|
|
3440 }
|
|
|
3441 else
|
|
|
3442 return Qnil;
|
|
|
3443 }
|
|
|
3444
|
|
|
3445 static Lisp_Object
|
|
|
3446 ucs_to_char (unsigned long code)
|
|
|
3447 {
|
|
442
|
3448 if (code < countof (fcd->ucs_to_mule_table))
|
|
428
|
3449 {
|
|
|
3450 return fcd->ucs_to_mule_table[code];
|
|
|
3451 }
|
|
|
3452 else if ((0xe00000 <= code) && (code <= 0xe00000 + 94 * 94 * 14))
|
|
|
3453 {
|
|
|
3454 unsigned int c;
|
|
|
3455
|
|
|
3456 code -= 0xe00000;
|
|
|
3457 c = code % (94 * 94);
|
|
|
3458 return make_char
|
|
|
3459 (MAKE_CHAR (CHARSET_BY_ATTRIBUTES
|
|
|
3460 (CHARSET_TYPE_94X94, code / (94 * 94) + '@',
|
|
|
3461 CHARSET_LEFT_TO_RIGHT),
|
|
|
3462 c / 94 + 33, c % 94 + 33));
|
|
|
3463 }
|
|
|
3464 else
|
|
|
3465 return Qnil;
|
|
|
3466 }
|
|
|
3467
|
|
|
3468 DEFUN ("ucs-char", Fucs_char, 1, 1, 0, /*
|
|
|
3469 Return Mule character corresponding to UCS code CODE (a positive integer).
|
|
|
3470 */
|
|
|
3471 (code))
|
|
|
3472 {
|
|
|
3473 CHECK_NATNUM (code);
|
|
|
3474 return ucs_to_char (XINT (code));
|
|
|
3475 }
|
|
|
3476
|
|
|
3477 DEFUN ("set-char-ucs", Fset_char_ucs, 2, 2, 0, /*
|
|
|
3478 Map Mule character CHARACTER to UCS code CODE (a positive integer).
|
|
|
3479 */
|
|
|
3480 (character, code))
|
|
|
3481 {
|
|
|
3482 /* #### Isn't this gilding the lily? Fput_char_table checks its args.
|
|
|
3483 Fset_char_ucs is more restrictive on index arg, but should
|
|
|
3484 check code arg in a char_table method. */
|
|
|
3485 CHECK_CHAR (character);
|
|
|
3486 CHECK_NATNUM (code);
|
|
|
3487 return Fput_char_table (character, code, mule_to_ucs_table);
|
|
|
3488 }
|
|
|
3489
|
|
|
3490 DEFUN ("char-ucs", Fchar_ucs, 1, 1, 0, /*
|
|
|
3491 Return the UCS code (a positive integer) corresponding to CHARACTER.
|
|
|
3492 */
|
|
|
3493 (character))
|
|
|
3494 {
|
|
|
3495 return Fget_char_table (character, mule_to_ucs_table);
|
|
|
3496 }
|
|
|
3497
|
|
|
3498 /* Decode a UCS-4 character into a buffer. If the lookup fails, use
|
|
|
3499 <GETA MARK> (U+3013) of JIS X 0208, which means correct character
|
|
|
3500 is not found, instead.
|
|
|
3501 #### do something more appropriate (use blob?)
|
|
|
3502 Danger, Will Robinson! Data loss. Should we signal user? */
|
|
|
3503 static void
|
|
|
3504 decode_ucs4 (unsigned long ch, unsigned_char_dynarr *dst)
|
|
|
3505 {
|
|
|
3506 Lisp_Object chr = ucs_to_char (ch);
|
|
|
3507
|
|
|
3508 if (! NILP (chr))
|
|
|
3509 {
|
|
|
3510 Bufbyte work[MAX_EMCHAR_LEN];
|
|
|
3511 int len;
|
|
|
3512
|
|
|
3513 ch = XCHAR (chr);
|
|
|
3514 len = (ch < 128) ?
|
|
|
3515 simple_set_charptr_emchar (work, ch) :
|
|
|
3516 non_ascii_set_charptr_emchar (work, ch);
|
|
|
3517 Dynarr_add_many (dst, work, len);
|
|
|
3518 }
|
|
|
3519 else
|
|
|
3520 {
|
|
|
3521 Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
|
|
|
3522 Dynarr_add (dst, 34 + 128);
|
|
|
3523 Dynarr_add (dst, 46 + 128);
|
|
|
3524 }
|
|
|
3525 }
|
|
|
3526
|
|
|
3527 static unsigned long
|
|
|
3528 mule_char_to_ucs4 (Lisp_Object charset,
|
|
|
3529 unsigned char h, unsigned char l)
|
|
|
3530 {
|
|
|
3531 Lisp_Object code
|
|
|
3532 = Fget_char_table (make_char (MAKE_CHAR (charset, h & 127, l & 127)),
|
|
|
3533 mule_to_ucs_table);
|
|
|
3534
|
|
|
3535 if (INTP (code))
|
|
|
3536 {
|
|
|
3537 return XINT (code);
|
|
|
3538 }
|
|
|
3539 else if ( (XCHARSET_DIMENSION (charset) == 2) &&
|
|
|
3540 (XCHARSET_CHARS (charset) == 94) )
|
|
|
3541 {
|
|
|
3542 unsigned char final = XCHARSET_FINAL (charset);
|
|
|
3543
|
|
|
3544 if ( ('@' <= final) && (final < 0x7f) )
|
|
|
3545 {
|
|
|
3546 return 0xe00000 + (final - '@') * 94 * 94
|
|
|
3547 + ((h & 127) - 33) * 94 + (l & 127) - 33;
|
|
|
3548 }
|
|
|
3549 else
|
|
|
3550 {
|
|
|
3551 return '?';
|
|
|
3552 }
|
|
|
3553 }
|
|
|
3554 else
|
|
|
3555 {
|
|
|
3556 return '?';
|
|
|
3557 }
|
|
|
3558 }
|
|
|
3559
|
|
|
3560 static void
|
|
|
3561 encode_ucs4 (Lisp_Object charset,
|
|
|
3562 unsigned char h, unsigned char l, unsigned_char_dynarr *dst)
|
|
|
3563 {
|
|
|
3564 unsigned long code = mule_char_to_ucs4 (charset, h, l);
|
|
|
3565 Dynarr_add (dst, code >> 24);
|
|
|
3566 Dynarr_add (dst, (code >> 16) & 255);
|
|
|
3567 Dynarr_add (dst, (code >> 8) & 255);
|
|
|
3568 Dynarr_add (dst, code & 255);
|
|
|
3569 }
|
|
|
3570
|
|
|
3571 static int
|
|
462
|
3572 detect_coding_ucs4 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
|
|
428
|
3573 {
|
|
|
3574 while (n--)
|
|
|
3575 {
|
|
444
|
3576 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3577 switch (st->ucs4.in_byte)
|
|
|
3578 {
|
|
|
3579 case 0:
|
|
|
3580 if (c >= 128)
|
|
|
3581 return 0;
|
|
|
3582 else
|
|
|
3583 st->ucs4.in_byte++;
|
|
|
3584 break;
|
|
|
3585 case 3:
|
|
|
3586 st->ucs4.in_byte = 0;
|
|
|
3587 break;
|
|
|
3588 default:
|
|
|
3589 st->ucs4.in_byte++;
|
|
|
3590 }
|
|
|
3591 }
|
|
|
3592 return CODING_CATEGORY_UCS4_MASK;
|
|
|
3593 }
|
|
|
3594
|
|
|
3595 static void
|
|
444
|
3596 decode_coding_ucs4 (Lstream *decoding, const Extbyte *src,
|
|
462
|
3597 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3598 {
|
|
|
3599 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
3600 unsigned int flags = str->flags;
|
|
|
3601 unsigned int ch = str->ch;
|
|
|
3602 unsigned char counter = str->counter;
|
|
|
3603
|
|
|
3604 while (n--)
|
|
|
3605 {
|
|
444
|
3606 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3607 switch (counter)
|
|
|
3608 {
|
|
|
3609 case 0:
|
|
|
3610 ch = c;
|
|
|
3611 counter = 3;
|
|
|
3612 break;
|
|
|
3613 case 1:
|
|
|
3614 decode_ucs4 ( ( ch << 8 ) | c, dst);
|
|
|
3615 ch = 0;
|
|
|
3616 counter = 0;
|
|
|
3617 break;
|
|
|
3618 default:
|
|
|
3619 ch = ( ch << 8 ) | c;
|
|
|
3620 counter--;
|
|
|
3621 }
|
|
|
3622 }
|
|
|
3623 if (counter & CODING_STATE_END)
|
|
|
3624 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
3625
|
|
|
3626 str->flags = flags;
|
|
|
3627 str->ch = ch;
|
|
|
3628 str->counter = counter;
|
|
|
3629 }
|
|
|
3630
|
|
|
3631 static void
|
|
444
|
3632 encode_coding_ucs4 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
3633 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3634 {
|
|
|
3635 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
3636 unsigned int flags = str->flags;
|
|
|
3637 unsigned int ch = str->ch;
|
|
|
3638 unsigned char char_boundary = str->iso2022.current_char_boundary;
|
|
|
3639 Lisp_Object charset = str->iso2022.current_charset;
|
|
|
3640
|
|
|
3641 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
3642 /* flags for handling composite chars. We do a little switcharoo
|
|
|
3643 on the source while we're outputting the composite char. */
|
|
|
3644 unsigned int saved_n = 0;
|
|
442
|
3645 const unsigned char *saved_src = NULL;
|
|
428
|
3646 int in_composite = 0;
|
|
|
3647
|
|
|
3648 back_to_square_n:
|
|
|
3649 #endif
|
|
|
3650
|
|
|
3651 while (n--)
|
|
|
3652 {
|
|
|
3653 unsigned char c = *src++;
|
|
|
3654
|
|
|
3655 if (BYTE_ASCII_P (c))
|
|
|
3656 { /* Processing ASCII character */
|
|
|
3657 ch = 0;
|
|
|
3658 encode_ucs4 (Vcharset_ascii, c, 0, dst);
|
|
|
3659 char_boundary = 1;
|
|
|
3660 }
|
|
|
3661 else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch))
|
|
|
3662 { /* Processing Leading Byte */
|
|
|
3663 ch = 0;
|
|
|
3664 charset = CHARSET_BY_LEADING_BYTE (c);
|
|
|
3665 if (LEADING_BYTE_PREFIX_P(c))
|
|
|
3666 ch = c;
|
|
|
3667 char_boundary = 0;
|
|
|
3668 }
|
|
|
3669 else
|
|
|
3670 { /* Processing Non-ASCII character */
|
|
|
3671 char_boundary = 1;
|
|
|
3672 if (EQ (charset, Vcharset_control_1))
|
|
|
3673 {
|
|
|
3674 encode_ucs4 (Vcharset_control_1, c, 0, dst);
|
|
|
3675 }
|
|
|
3676 else
|
|
|
3677 {
|
|
|
3678 switch (XCHARSET_REP_BYTES (charset))
|
|
|
3679 {
|
|
|
3680 case 2:
|
|
|
3681 encode_ucs4 (charset, c, 0, dst);
|
|
|
3682 break;
|
|
|
3683 case 3:
|
|
|
3684 if (XCHARSET_PRIVATE_P (charset))
|
|
|
3685 {
|
|
|
3686 encode_ucs4 (charset, c, 0, dst);
|
|
|
3687 ch = 0;
|
|
|
3688 }
|
|
|
3689 else if (ch)
|
|
|
3690 {
|
|
|
3691 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
3692 if (EQ (charset, Vcharset_composite))
|
|
|
3693 {
|
|
|
3694 if (in_composite)
|
|
|
3695 {
|
|
|
3696 /* #### Bother! We don't know how to
|
|
|
3697 handle this yet. */
|
|
444
|
3698 Dynarr_add (dst, '\0');
|
|
|
3699 Dynarr_add (dst, '\0');
|
|
|
3700 Dynarr_add (dst, '\0');
|
|
428
|
3701 Dynarr_add (dst, '~');
|
|
|
3702 }
|
|
|
3703 else
|
|
|
3704 {
|
|
|
3705 Emchar emch = MAKE_CHAR (Vcharset_composite,
|
|
|
3706 ch & 0x7F, c & 0x7F);
|
|
|
3707 Lisp_Object lstr = composite_char_string (emch);
|
|
|
3708 saved_n = n;
|
|
|
3709 saved_src = src;
|
|
|
3710 in_composite = 1;
|
|
|
3711 src = XSTRING_DATA (lstr);
|
|
|
3712 n = XSTRING_LENGTH (lstr);
|
|
|
3713 }
|
|
|
3714 }
|
|
|
3715 else
|
|
|
3716 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
3717 {
|
|
|
3718 encode_ucs4(charset, ch, c, dst);
|
|
|
3719 }
|
|
|
3720 ch = 0;
|
|
|
3721 }
|
|
|
3722 else
|
|
|
3723 {
|
|
|
3724 ch = c;
|
|
|
3725 char_boundary = 0;
|
|
|
3726 }
|
|
|
3727 break;
|
|
|
3728 case 4:
|
|
|
3729 if (ch)
|
|
|
3730 {
|
|
|
3731 encode_ucs4 (charset, ch, c, dst);
|
|
|
3732 ch = 0;
|
|
|
3733 }
|
|
|
3734 else
|
|
|
3735 {
|
|
|
3736 ch = c;
|
|
|
3737 char_boundary = 0;
|
|
|
3738 }
|
|
|
3739 break;
|
|
|
3740 default:
|
|
|
3741 abort ();
|
|
|
3742 }
|
|
|
3743 }
|
|
|
3744 }
|
|
|
3745 }
|
|
|
3746
|
|
|
3747 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
3748 if (in_composite)
|
|
|
3749 {
|
|
|
3750 n = saved_n;
|
|
|
3751 src = saved_src;
|
|
|
3752 in_composite = 0;
|
|
|
3753 goto back_to_square_n; /* Wheeeeeeeee ..... */
|
|
|
3754 }
|
|
|
3755 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
3756
|
|
|
3757 str->flags = flags;
|
|
|
3758 str->ch = ch;
|
|
|
3759 str->iso2022.current_char_boundary = char_boundary;
|
|
|
3760 str->iso2022.current_charset = charset;
|
|
|
3761
|
|
|
3762 /* Verbum caro factum est! */
|
|
|
3763 }
|
|
|
3764
|
|
|
3765
|
|
|
3766 /************************************************************************/
|
|
|
3767 /* UTF-8 methods */
|
|
|
3768 /************************************************************************/
|
|
|
3769
|
|
|
3770 static int
|
|
462
|
3771 detect_coding_utf8 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
|
|
428
|
3772 {
|
|
|
3773 while (n--)
|
|
|
3774 {
|
|
444
|
3775 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3776 switch (st->utf8.in_byte)
|
|
|
3777 {
|
|
|
3778 case 0:
|
|
|
3779 if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
|
|
|
3780 return 0;
|
|
|
3781 else if (c >= 0xfc)
|
|
|
3782 st->utf8.in_byte = 5;
|
|
|
3783 else if (c >= 0xf8)
|
|
|
3784 st->utf8.in_byte = 4;
|
|
|
3785 else if (c >= 0xf0)
|
|
|
3786 st->utf8.in_byte = 3;
|
|
|
3787 else if (c >= 0xe0)
|
|
|
3788 st->utf8.in_byte = 2;
|
|
|
3789 else if (c >= 0xc0)
|
|
|
3790 st->utf8.in_byte = 1;
|
|
|
3791 else if (c >= 0x80)
|
|
|
3792 return 0;
|
|
|
3793 break;
|
|
|
3794 default:
|
|
|
3795 if ((c & 0xc0) != 0x80)
|
|
|
3796 return 0;
|
|
|
3797 else
|
|
|
3798 st->utf8.in_byte--;
|
|
|
3799 }
|
|
|
3800 }
|
|
|
3801 return CODING_CATEGORY_UTF8_MASK;
|
|
|
3802 }
|
|
|
3803
|
|
|
3804 static void
|
|
444
|
3805 decode_coding_utf8 (Lstream *decoding, const Extbyte *src,
|
|
462
|
3806 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3807 {
|
|
|
3808 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
3809 unsigned int flags = str->flags;
|
|
|
3810 unsigned int ch = str->ch;
|
|
|
3811 eol_type_t eol_type = str->eol_type;
|
|
|
3812 unsigned char counter = str->counter;
|
|
|
3813
|
|
|
3814 while (n--)
|
|
|
3815 {
|
|
444
|
3816 unsigned char c = *(unsigned char *)src++;
|
|
428
|
3817 switch (counter)
|
|
|
3818 {
|
|
|
3819 case 0:
|
|
|
3820 if ( c >= 0xfc )
|
|
|
3821 {
|
|
|
3822 ch = c & 0x01;
|
|
|
3823 counter = 5;
|
|
|
3824 }
|
|
|
3825 else if ( c >= 0xf8 )
|
|
|
3826 {
|
|
|
3827 ch = c & 0x03;
|
|
|
3828 counter = 4;
|
|
|
3829 }
|
|
|
3830 else if ( c >= 0xf0 )
|
|
|
3831 {
|
|
|
3832 ch = c & 0x07;
|
|
|
3833 counter = 3;
|
|
|
3834 }
|
|
|
3835 else if ( c >= 0xe0 )
|
|
|
3836 {
|
|
|
3837 ch = c & 0x0f;
|
|
|
3838 counter = 2;
|
|
|
3839 }
|
|
|
3840 else if ( c >= 0xc0 )
|
|
|
3841 {
|
|
|
3842 ch = c & 0x1f;
|
|
|
3843 counter = 1;
|
|
|
3844 }
|
|
|
3845 else
|
|
|
3846 {
|
|
|
3847 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
3848 decode_ucs4 (c, dst);
|
|
|
3849 }
|
|
|
3850 break;
|
|
|
3851 case 1:
|
|
|
3852 ch = ( ch << 6 ) | ( c & 0x3f );
|
|
|
3853 decode_ucs4 (ch, dst);
|
|
|
3854 ch = 0;
|
|
|
3855 counter = 0;
|
|
|
3856 break;
|
|
|
3857 default:
|
|
|
3858 ch = ( ch << 6 ) | ( c & 0x3f );
|
|
|
3859 counter--;
|
|
|
3860 }
|
|
|
3861 label_continue_loop:;
|
|
|
3862 }
|
|
|
3863
|
|
|
3864 if (flags & CODING_STATE_END)
|
|
|
3865 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
3866
|
|
|
3867 str->flags = flags;
|
|
|
3868 str->ch = ch;
|
|
|
3869 str->counter = counter;
|
|
|
3870 }
|
|
|
3871
|
|
|
3872 static void
|
|
|
3873 encode_utf8 (Lisp_Object charset,
|
|
|
3874 unsigned char h, unsigned char l, unsigned_char_dynarr *dst)
|
|
|
3875 {
|
|
|
3876 unsigned long code = mule_char_to_ucs4 (charset, h, l);
|
|
|
3877 if ( code <= 0x7f )
|
|
|
3878 {
|
|
|
3879 Dynarr_add (dst, code);
|
|
|
3880 }
|
|
|
3881 else if ( code <= 0x7ff )
|
|
|
3882 {
|
|
|
3883 Dynarr_add (dst, (code >> 6) | 0xc0);
|
|
|
3884 Dynarr_add (dst, (code & 0x3f) | 0x80);
|
|
|
3885 }
|
|
|
3886 else if ( code <= 0xffff )
|
|
|
3887 {
|
|
|
3888 Dynarr_add (dst, (code >> 12) | 0xe0);
|
|
|
3889 Dynarr_add (dst, ((code >> 6) & 0x3f) | 0x80);
|
|
|
3890 Dynarr_add (dst, (code & 0x3f) | 0x80);
|
|
|
3891 }
|
|
|
3892 else if ( code <= 0x1fffff )
|
|
|
3893 {
|
|
|
3894 Dynarr_add (dst, (code >> 18) | 0xf0);
|
|
|
3895 Dynarr_add (dst, ((code >> 12) & 0x3f) | 0x80);
|
|
|
3896 Dynarr_add (dst, ((code >> 6) & 0x3f) | 0x80);
|
|
|
3897 Dynarr_add (dst, (code & 0x3f) | 0x80);
|
|
|
3898 }
|
|
|
3899 else if ( code <= 0x3ffffff )
|
|
|
3900 {
|
|
|
3901 Dynarr_add (dst, (code >> 24) | 0xf8);
|
|
|
3902 Dynarr_add (dst, ((code >> 18) & 0x3f) | 0x80);
|
|
|
3903 Dynarr_add (dst, ((code >> 12) & 0x3f) | 0x80);
|
|
|
3904 Dynarr_add (dst, ((code >> 6) & 0x3f) | 0x80);
|
|
|
3905 Dynarr_add (dst, (code & 0x3f) | 0x80);
|
|
|
3906 }
|
|
|
3907 else
|
|
|
3908 {
|
|
|
3909 Dynarr_add (dst, (code >> 30) | 0xfc);
|
|
|
3910 Dynarr_add (dst, ((code >> 24) & 0x3f) | 0x80);
|
|
|
3911 Dynarr_add (dst, ((code >> 18) & 0x3f) | 0x80);
|
|
|
3912 Dynarr_add (dst, ((code >> 12) & 0x3f) | 0x80);
|
|
|
3913 Dynarr_add (dst, ((code >> 6) & 0x3f) | 0x80);
|
|
|
3914 Dynarr_add (dst, (code & 0x3f) | 0x80);
|
|
|
3915 }
|
|
|
3916 }
|
|
|
3917
|
|
|
3918 static void
|
|
444
|
3919 encode_coding_utf8 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
3920 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
3921 {
|
|
|
3922 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
3923 unsigned int flags = str->flags;
|
|
|
3924 unsigned int ch = str->ch;
|
|
|
3925 eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
|
|
|
3926 unsigned char char_boundary = str->iso2022.current_char_boundary;
|
|
|
3927 Lisp_Object charset = str->iso2022.current_charset;
|
|
|
3928
|
|
|
3929 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
3930 /* flags for handling composite chars. We do a little switcharoo
|
|
|
3931 on the source while we're outputting the composite char. */
|
|
|
3932 unsigned int saved_n = 0;
|
|
442
|
3933 const unsigned char *saved_src = NULL;
|
|
428
|
3934 int in_composite = 0;
|
|
|
3935
|
|
|
3936 back_to_square_n:
|
|
|
3937 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
3938
|
|
|
3939 while (n--)
|
|
|
3940 {
|
|
|
3941 unsigned char c = *src++;
|
|
|
3942
|
|
|
3943 if (BYTE_ASCII_P (c))
|
|
|
3944 { /* Processing ASCII character */
|
|
|
3945 ch = 0;
|
|
|
3946 if (c == '\n')
|
|
|
3947 {
|
|
|
3948 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
|
|
|
3949 Dynarr_add (dst, '\r');
|
|
|
3950 if (eol_type != EOL_CR)
|
|
|
3951 Dynarr_add (dst, c);
|
|
|
3952 }
|
|
|
3953 else
|
|
|
3954 encode_utf8 (Vcharset_ascii, c, 0, dst);
|
|
|
3955 char_boundary = 1;
|
|
|
3956 }
|
|
|
3957 else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch))
|
|
|
3958 { /* Processing Leading Byte */
|
|
|
3959 ch = 0;
|
|
|
3960 charset = CHARSET_BY_LEADING_BYTE (c);
|
|
|
3961 if (LEADING_BYTE_PREFIX_P(c))
|
|
|
3962 ch = c;
|
|
|
3963 char_boundary = 0;
|
|
|
3964 }
|
|
|
3965 else
|
|
|
3966 { /* Processing Non-ASCII character */
|
|
|
3967 char_boundary = 1;
|
|
|
3968 if (EQ (charset, Vcharset_control_1))
|
|
|
3969 {
|
|
|
3970 encode_utf8 (Vcharset_control_1, c, 0, dst);
|
|
|
3971 }
|
|
|
3972 else
|
|
|
3973 {
|
|
|
3974 switch (XCHARSET_REP_BYTES (charset))
|
|
|
3975 {
|
|
|
3976 case 2:
|
|
|
3977 encode_utf8 (charset, c, 0, dst);
|
|
|
3978 break;
|
|
|
3979 case 3:
|
|
|
3980 if (XCHARSET_PRIVATE_P (charset))
|
|
|
3981 {
|
|
|
3982 encode_utf8 (charset, c, 0, dst);
|
|
|
3983 ch = 0;
|
|
|
3984 }
|
|
|
3985 else if (ch)
|
|
|
3986 {
|
|
|
3987 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
3988 if (EQ (charset, Vcharset_composite))
|
|
|
3989 {
|
|
|
3990 if (in_composite)
|
|
|
3991 {
|
|
|
3992 /* #### Bother! We don't know how to
|
|
|
3993 handle this yet. */
|
|
|
3994 encode_utf8 (Vcharset_ascii, '~', 0, dst);
|
|
|
3995 }
|
|
|
3996 else
|
|
|
3997 {
|
|
|
3998 Emchar emch = MAKE_CHAR (Vcharset_composite,
|
|
|
3999 ch & 0x7F, c & 0x7F);
|
|
|
4000 Lisp_Object lstr = composite_char_string (emch);
|
|
|
4001 saved_n = n;
|
|
|
4002 saved_src = src;
|
|
|
4003 in_composite = 1;
|
|
|
4004 src = XSTRING_DATA (lstr);
|
|
|
4005 n = XSTRING_LENGTH (lstr);
|
|
|
4006 }
|
|
|
4007 }
|
|
|
4008 else
|
|
|
4009 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
4010 {
|
|
|
4011 encode_utf8 (charset, ch, c, dst);
|
|
|
4012 }
|
|
|
4013 ch = 0;
|
|
|
4014 }
|
|
|
4015 else
|
|
|
4016 {
|
|
|
4017 ch = c;
|
|
|
4018 char_boundary = 0;
|
|
|
4019 }
|
|
|
4020 break;
|
|
|
4021 case 4:
|
|
|
4022 if (ch)
|
|
|
4023 {
|
|
|
4024 encode_utf8 (charset, ch, c, dst);
|
|
|
4025 ch = 0;
|
|
|
4026 }
|
|
|
4027 else
|
|
|
4028 {
|
|
|
4029 ch = c;
|
|
|
4030 char_boundary = 0;
|
|
|
4031 }
|
|
|
4032 break;
|
|
|
4033 default:
|
|
|
4034 abort ();
|
|
|
4035 }
|
|
|
4036 }
|
|
|
4037 }
|
|
|
4038 }
|
|
|
4039
|
|
|
4040 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4041 if (in_composite)
|
|
|
4042 {
|
|
|
4043 n = saved_n;
|
|
|
4044 src = saved_src;
|
|
|
4045 in_composite = 0;
|
|
|
4046 goto back_to_square_n; /* Wheeeeeeeee ..... */
|
|
|
4047 }
|
|
|
4048 #endif
|
|
|
4049
|
|
|
4050 str->flags = flags;
|
|
|
4051 str->ch = ch;
|
|
|
4052 str->iso2022.current_char_boundary = char_boundary;
|
|
|
4053 str->iso2022.current_charset = charset;
|
|
|
4054
|
|
|
4055 /* Verbum caro factum est! */
|
|
|
4056 }
|
|
|
4057
|
|
|
4058
|
|
|
4059 /************************************************************************/
|
|
|
4060 /* ISO2022 methods */
|
|
|
4061 /************************************************************************/
|
|
|
4062
|
|
|
4063 /* The following note describes the coding system ISO2022 briefly.
|
|
|
4064 Since the intention of this note is to help understand the
|
|
|
4065 functions in this file, some parts are NOT ACCURATE or OVERLY
|
|
|
4066 SIMPLIFIED. For thorough understanding, please refer to the
|
|
|
4067 original document of ISO2022.
|
|
|
4068
|
|
|
4069 ISO2022 provides many mechanisms to encode several character sets
|
|
|
4070 in 7-bit and 8-bit environments. For 7-bit environments, all text
|
|
|
4071 is encoded using bytes less than 128. This may make the encoded
|
|
|
4072 text a little bit longer, but the text passes more easily through
|
|
|
4073 several gateways, some of which strip off MSB (Most Signigant Bit).
|
|
|
4074
|
|
|
4075 There are two kinds of character sets: control character set and
|
|
|
4076 graphic character set. The former contains control characters such
|
|
|
4077 as `newline' and `escape' to provide control functions (control
|
|
|
4078 functions are also provided by escape sequences). The latter
|
|
|
4079 contains graphic characters such as 'A' and '-'. Emacs recognizes
|
|
|
4080 two control character sets and many graphic character sets.
|
|
|
4081
|
|
|
4082 Graphic character sets are classified into one of the following
|
|
|
4083 four classes, according to the number of bytes (DIMENSION) and
|
|
|
4084 number of characters in one dimension (CHARS) of the set:
|
|
|
4085 - DIMENSION1_CHARS94
|
|
|
4086 - DIMENSION1_CHARS96
|
|
|
4087 - DIMENSION2_CHARS94
|
|
|
4088 - DIMENSION2_CHARS96
|
|
|
4089
|
|
|
4090 In addition, each character set is assigned an identification tag,
|
|
|
4091 unique for each set, called "final character" (denoted as <F>
|
|
|
4092 hereafter). The <F> of each character set is decided by ECMA(*)
|
|
|
4093 when it is registered in ISO. The code range of <F> is 0x30..0x7F
|
|
|
4094 (0x30..0x3F are for private use only).
|
|
|
4095
|
|
|
4096 Note (*): ECMA = European Computer Manufacturers Association
|
|
|
4097
|
|
|
4098 Here are examples of graphic character set [NAME(<F>)]:
|
|
|
4099 o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
|
|
|
4100 o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
|
|
|
4101 o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
|
|
|
4102 o DIMENSION2_CHARS96 -- none for the moment
|
|
|
4103
|
|
|
4104 A code area (1 byte = 8 bits) is divided into 4 areas, C0, GL, C1, and GR.
|
|
|
4105 C0 [0x00..0x1F] -- control character plane 0
|
|
|
4106 GL [0x20..0x7F] -- graphic character plane 0
|
|
|
4107 C1 [0x80..0x9F] -- control character plane 1
|
|
|
4108 GR [0xA0..0xFF] -- graphic character plane 1
|
|
|
4109
|
|
|
4110 A control character set is directly designated and invoked to C0 or
|
|
|
4111 C1 by an escape sequence. The most common case is that:
|
|
|
4112 - ISO646's control character set is designated/invoked to C0, and
|
|
|
4113 - ISO6429's control character set is designated/invoked to C1,
|
|
|
4114 and usually these designations/invocations are omitted in encoded
|
|
|
4115 text. In a 7-bit environment, only C0 can be used, and a control
|
|
|
4116 character for C1 is encoded by an appropriate escape sequence to
|
|
|
4117 fit into the environment. All control characters for C1 are
|
|
|
4118 defined to have corresponding escape sequences.
|
|
|
4119
|
|
|
4120 A graphic character set is at first designated to one of four
|
|
|
4121 graphic registers (G0 through G3), then these graphic registers are
|
|
|
4122 invoked to GL or GR. These designations and invocations can be
|
|
|
4123 done independently. The most common case is that G0 is invoked to
|
|
|
4124 GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
|
|
|
4125 these invocations and designations are omitted in encoded text.
|
|
|
4126 In a 7-bit environment, only GL can be used.
|
|
|
4127
|
|
|
4128 When a graphic character set of CHARS94 is invoked to GL, codes
|
|
|
4129 0x20 and 0x7F of the GL area work as control characters SPACE and
|
|
|
4130 DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
|
|
|
4131 be used.
|
|
|
4132
|
|
|
4133 There are two ways of invocation: locking-shift and single-shift.
|
|
|
4134 With locking-shift, the invocation lasts until the next different
|
|
|
4135 invocation, whereas with single-shift, the invocation affects the
|
|
|
4136 following character only and doesn't affect the locking-shift
|
|
|
4137 state. Invocations are done by the following control characters or
|
|
|
4138 escape sequences:
|
|
|
4139
|
|
|
4140 ----------------------------------------------------------------------
|
|
|
4141 abbrev function cntrl escape seq description
|
|
|
4142 ----------------------------------------------------------------------
|
|
|
4143 SI/LS0 (shift-in) 0x0F none invoke G0 into GL
|
|
|
4144 SO/LS1 (shift-out) 0x0E none invoke G1 into GL
|
|
|
4145 LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
|
|
|
4146 LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
|
|
|
4147 LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR (*)
|
|
|
4148 LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR (*)
|
|
|
4149 LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR (*)
|
|
|
4150 SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
|
|
|
4151 SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
|
|
|
4152 ----------------------------------------------------------------------
|
|
|
4153 (*) These are not used by any known coding system.
|
|
|
4154
|
|
|
4155 Control characters for these functions are defined by macros
|
|
|
4156 ISO_CODE_XXX in `coding.h'.
|
|
|
4157
|
|
|
4158 Designations are done by the following escape sequences:
|
|
|
4159 ----------------------------------------------------------------------
|
|
|
4160 escape sequence description
|
|
|
4161 ----------------------------------------------------------------------
|
|
|
4162 ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
|
|
|
4163 ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
|
|
|
4164 ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
|
|
|
4165 ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
|
|
|
4166 ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
|
|
|
4167 ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
|
|
|
4168 ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
|
|
|
4169 ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
|
|
|
4170 ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
|
|
|
4171 ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
|
|
|
4172 ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
|
|
|
4173 ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
|
|
|
4174 ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
|
|
|
4175 ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
|
|
|
4176 ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
|
|
|
4177 ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
|
|
|
4178 ----------------------------------------------------------------------
|
|
|
4179
|
|
|
4180 In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
|
|
|
4181 of dimension 1, chars 94, and final character <F>, etc...
|
|
|
4182
|
|
|
4183 Note (*): Although these designations are not allowed in ISO2022,
|
|
|
4184 Emacs accepts them on decoding, and produces them on encoding
|
|
|
4185 CHARS96 character sets in a coding system which is characterized as
|
|
|
4186 7-bit environment, non-locking-shift, and non-single-shift.
|
|
|
4187
|
|
|
4188 Note (**): If <F> is '@', 'A', or 'B', the intermediate character
|
|
|
4189 '(' can be omitted. We refer to this as "short-form" hereafter.
|
|
|
4190
|
|
|
4191 Now you may notice that there are a lot of ways for encoding the
|
|
|
4192 same multilingual text in ISO2022. Actually, there exist many
|
|
|
4193 coding systems such as Compound Text (used in X11's inter client
|
|
|
4194 communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR
|
|
|
4195 (used in Korean internet), EUC (Extended UNIX Code, used in Asian
|
|
|
4196 localized platforms), and all of these are variants of ISO2022.
|
|
|
4197
|
|
|
4198 In addition to the above, Emacs handles two more kinds of escape
|
|
|
4199 sequences: ISO6429's direction specification and Emacs' private
|
|
|
4200 sequence for specifying character composition.
|
|
|
4201
|
|
|
4202 ISO6429's direction specification takes the following form:
|
|
|
4203 o CSI ']' -- end of the current direction
|
|
|
4204 o CSI '0' ']' -- end of the current direction
|
|
|
4205 o CSI '1' ']' -- start of left-to-right text
|
|
|
4206 o CSI '2' ']' -- start of right-to-left text
|
|
|
4207 The control character CSI (0x9B: control sequence introducer) is
|
|
|
4208 abbreviated to the escape sequence ESC '[' in a 7-bit environment.
|
|
|
4209
|
|
|
4210 Character composition specification takes the following form:
|
|
|
4211 o ESC '0' -- start character composition
|
|
|
4212 o ESC '1' -- end character composition
|
|
|
4213 Since these are not standard escape sequences of any ISO standard,
|
|
|
4214 their use with these meanings is restricted to Emacs only. */
|
|
|
4215
|
|
|
4216 static void
|
|
|
4217 reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso)
|
|
|
4218 {
|
|
|
4219 int i;
|
|
|
4220
|
|
|
4221 for (i = 0; i < 4; i++)
|
|
|
4222 {
|
|
|
4223 if (!NILP (coding_system))
|
|
|
4224 iso->charset[i] =
|
|
|
4225 XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i);
|
|
|
4226 else
|
|
|
4227 iso->charset[i] = Qt;
|
|
|
4228 iso->invalid_designated[i] = 0;
|
|
|
4229 }
|
|
|
4230 iso->esc = ISO_ESC_NOTHING;
|
|
|
4231 iso->esc_bytes_index = 0;
|
|
|
4232 iso->register_left = 0;
|
|
|
4233 iso->register_right = 1;
|
|
|
4234 iso->switched_dir_and_no_valid_charset_yet = 0;
|
|
|
4235 iso->invalid_switch_dir = 0;
|
|
|
4236 iso->output_direction_sequence = 0;
|
|
|
4237 iso->output_literally = 0;
|
|
|
4238 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4239 if (iso->composite_chars)
|
|
|
4240 Dynarr_reset (iso->composite_chars);
|
|
|
4241 #endif
|
|
|
4242 }
|
|
|
4243
|
|
|
4244 static int
|
|
|
4245 fit_to_be_escape_quoted (unsigned char c)
|
|
|
4246 {
|
|
|
4247 switch (c)
|
|
|
4248 {
|
|
|
4249 case ISO_CODE_ESC:
|
|
|
4250 case ISO_CODE_CSI:
|
|
|
4251 case ISO_CODE_SS2:
|
|
|
4252 case ISO_CODE_SS3:
|
|
|
4253 case ISO_CODE_SO:
|
|
|
4254 case ISO_CODE_SI:
|
|
|
4255 return 1;
|
|
|
4256
|
|
|
4257 default:
|
|
|
4258 return 0;
|
|
|
4259 }
|
|
|
4260 }
|
|
|
4261
|
|
|
4262 /* Parse one byte of an ISO2022 escape sequence.
|
|
|
4263 If the result is an invalid escape sequence, return 0 and
|
|
|
4264 do not change anything in STR. Otherwise, if the result is
|
|
|
4265 an incomplete escape sequence, update ISO2022.ESC and
|
|
|
4266 ISO2022.ESC_BYTES and return -1. Otherwise, update
|
|
|
4267 all the state variables (but not ISO2022.ESC_BYTES) and
|
|
|
4268 return 1.
|
|
|
4269
|
|
|
4270 If CHECK_INVALID_CHARSETS is non-zero, check for designation
|
|
|
4271 or invocation of an invalid character set and treat that as
|
|
448
|
4272 an unrecognized escape sequence.
|
|
|
4273
|
|
|
4274 ********************************************************************
|
|
|
4275
|
|
|
4276 #### Strategies for error annotation and coding orthogonalization
|
|
|
4277
|
|
|
4278 We really want to separate out a number of things. Conceptually,
|
|
|
4279 there is a nested syntax.
|
|
|
4280
|
|
|
4281 At the top level is the ISO 2022 extension syntax, including charset
|
|
|
4282 designation and invocation, and certain auxiliary controls such as the
|
|
|
4283 ISO 6429 direction specification. These are octet-oriented, with the
|
|
|
4284 single exception (AFAIK) of the "exit Unicode" sequence which uses the
|
|
|
4285 UTF's natural width (1 byte for UTF-7 and UTF-8, 2 bytes for UCS-2 and
|
|
|
4286 UTF-16, and 4 bytes for UCS-4 and UTF-32). This will be treated as a
|
|
|
4287 (deprecated) special case in Unicode processing.
|
|
|
4288
|
|
|
4289 The middle layer is ISO 2022 character interpretation. This will depend
|
|
|
4290 on the current state of the ISO 2022 registers, and assembles octets
|
|
|
4291 into the character's internal representation.
|
|
|
4292
|
|
|
4293 The lowest level is translating system control conventions. At present
|
|
|
4294 this is restricted to newline translation, but one could imagine doing
|
|
|
4295 tab conversion or line wrapping here. "Escape from Unicode" processing
|
|
|
4296 would be done at this level.
|
|
|
4297
|
|
|
4298 At each level the parser will verify the syntax. In the case of a
|
|
|
4299 syntax error or warning (such as a redundant escape sequence that affects
|
|
|
4300 no characters), the parser will take some action, typically inserting the
|
|
|
4301 erroneous octets directly into the output and creating an annotation
|
|
|
4302 which can be used by higher level I/O to mark the affected region.
|
|
|
4303
|
|
|
4304 This should make it possible to do something sensible about separating
|
|
|
4305 newline convention processing from character construction, and about
|
|
|
4306 preventing ISO 2022 escape sequences from being recognized
|
|
|
4307 inappropriately.
|
|
|
4308
|
|
|
4309 The basic strategy will be to have octet classification tables, and
|
|
|
4310 switch processing according to the table entry.
|
|
|
4311
|
|
|
4312 It's possible that, by doing the processing with tables of functions or
|
|
|
4313 the like, the parser can be used for both detection and translation. */
|
|
428
|
4314
|
|
|
4315 static int
|
|
|
4316 parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso,
|
|
|
4317 unsigned char c, unsigned int *flags,
|
|
|
4318 int check_invalid_charsets)
|
|
|
4319 {
|
|
|
4320 /* (1) If we're at the end of a designation sequence, CS is the
|
|
|
4321 charset being designated and REG is the register to designate
|
|
|
4322 it to.
|
|
|
4323
|
|
|
4324 (2) If we're at the end of a locking-shift sequence, REG is
|
|
|
4325 the register to invoke and HALF (0 == left, 1 == right) is
|
|
|
4326 the half to invoke it into.
|
|
|
4327
|
|
|
4328 (3) If we're at the end of a single-shift sequence, REG is
|
|
|
4329 the register to invoke. */
|
|
|
4330 Lisp_Object cs = Qnil;
|
|
|
4331 int reg, half;
|
|
|
4332
|
|
|
4333 /* NOTE: This code does goto's all over the fucking place.
|
|
|
4334 The reason for this is that we're basically implementing
|
|
|
4335 a state machine here, and hierarchical languages like C
|
|
|
4336 don't really provide a clean way of doing this. */
|
|
|
4337
|
|
|
4338 if (! (*flags & CODING_STATE_ESCAPE))
|
|
|
4339 /* At beginning of escape sequence; we need to reset our
|
|
|
4340 escape-state variables. */
|
|
|
4341 iso->esc = ISO_ESC_NOTHING;
|
|
|
4342
|
|
|
4343 iso->output_literally = 0;
|
|
|
4344 iso->output_direction_sequence = 0;
|
|
|
4345
|
|
|
4346 switch (iso->esc)
|
|
|
4347 {
|
|
|
4348 case ISO_ESC_NOTHING:
|
|
|
4349 iso->esc_bytes_index = 0;
|
|
|
4350 switch (c)
|
|
|
4351 {
|
|
|
4352 case ISO_CODE_ESC: /* Start escape sequence */
|
|
|
4353 *flags |= CODING_STATE_ESCAPE;
|
|
|
4354 iso->esc = ISO_ESC;
|
|
|
4355 goto not_done;
|
|
|
4356
|
|
|
4357 case ISO_CODE_CSI: /* ISO6429 (specifying directionality) */
|
|
|
4358 *flags |= CODING_STATE_ESCAPE;
|
|
|
4359 iso->esc = ISO_ESC_5_11;
|
|
|
4360 goto not_done;
|
|
|
4361
|
|
|
4362 case ISO_CODE_SO: /* locking shift 1 */
|
|
|
4363 reg = 1; half = 0;
|
|
|
4364 goto locking_shift;
|
|
|
4365 case ISO_CODE_SI: /* locking shift 0 */
|
|
|
4366 reg = 0; half = 0;
|
|
|
4367 goto locking_shift;
|
|
|
4368
|
|
|
4369 case ISO_CODE_SS2: /* single shift */
|
|
|
4370 reg = 2;
|
|
|
4371 goto single_shift;
|
|
|
4372 case ISO_CODE_SS3: /* single shift */
|
|
|
4373 reg = 3;
|
|
|
4374 goto single_shift;
|
|
|
4375
|
|
|
4376 default: /* Other control characters */
|
|
|
4377 return 0;
|
|
|
4378 }
|
|
|
4379
|
|
|
4380 case ISO_ESC:
|
|
|
4381 switch (c)
|
|
|
4382 {
|
|
|
4383 /**** single shift ****/
|
|
|
4384
|
|
|
4385 case 'N': /* single shift 2 */
|
|
|
4386 reg = 2;
|
|
|
4387 goto single_shift;
|
|
|
4388 case 'O': /* single shift 3 */
|
|
|
4389 reg = 3;
|
|
|
4390 goto single_shift;
|
|
|
4391
|
|
|
4392 /**** locking shift ****/
|
|
|
4393
|
|
|
4394 case '~': /* locking shift 1 right */
|
|
|
4395 reg = 1; half = 1;
|
|
|
4396 goto locking_shift;
|
|
|
4397 case 'n': /* locking shift 2 */
|
|
|
4398 reg = 2; half = 0;
|
|
|
4399 goto locking_shift;
|
|
|
4400 case '}': /* locking shift 2 right */
|
|
|
4401 reg = 2; half = 1;
|
|
|
4402 goto locking_shift;
|
|
|
4403 case 'o': /* locking shift 3 */
|
|
|
4404 reg = 3; half = 0;
|
|
|
4405 goto locking_shift;
|
|
|
4406 case '|': /* locking shift 3 right */
|
|
|
4407 reg = 3; half = 1;
|
|
|
4408 goto locking_shift;
|
|
|
4409
|
|
|
4410 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4411 /**** composite ****/
|
|
|
4412
|
|
|
4413 case '0':
|
|
|
4414 iso->esc = ISO_ESC_START_COMPOSITE;
|
|
|
4415 *flags = (*flags & CODING_STATE_ISO2022_LOCK) |
|
|
|
4416 CODING_STATE_COMPOSITE;
|
|
|
4417 return 1;
|
|
|
4418
|
|
|
4419 case '1':
|
|
|
4420 iso->esc = ISO_ESC_END_COMPOSITE;
|
|
|
4421 *flags = (*flags & CODING_STATE_ISO2022_LOCK) &
|
|
|
4422 ~CODING_STATE_COMPOSITE;
|
|
|
4423 return 1;
|
|
|
4424 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
4425
|
|
|
4426 /**** directionality ****/
|
|
|
4427
|
|
|
4428 case '[':
|
|
|
4429 iso->esc = ISO_ESC_5_11;
|
|
|
4430 goto not_done;
|
|
|
4431
|
|
|
4432 /**** designation ****/
|
|
|
4433
|
|
|
4434 case '$': /* multibyte charset prefix */
|
|
|
4435 iso->esc = ISO_ESC_2_4;
|
|
|
4436 goto not_done;
|
|
|
4437
|
|
|
4438 default:
|
|
|
4439 if (0x28 <= c && c <= 0x2F)
|
|
|
4440 {
|
|
|
4441 iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8);
|
|
|
4442 goto not_done;
|
|
|
4443 }
|
|
|
4444
|
|
|
4445 /* This function is called with CODESYS equal to nil when
|
|
|
4446 doing coding-system detection. */
|
|
|
4447 if (!NILP (codesys)
|
|
|
4448 && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
|
|
|
4449 && fit_to_be_escape_quoted (c))
|
|
|
4450 {
|
|
|
4451 iso->esc = ISO_ESC_LITERAL;
|
|
|
4452 *flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4453 return 1;
|
|
|
4454 }
|
|
|
4455
|
|
|
4456 /* bzzzt! */
|
|
|
4457 return 0;
|
|
|
4458 }
|
|
|
4459
|
|
|
4460
|
|
|
4461
|
|
|
4462 /**** directionality ****/
|
|
|
4463
|
|
|
4464 case ISO_ESC_5_11: /* ISO6429 direction control */
|
|
|
4465 if (c == ']')
|
|
|
4466 {
|
|
|
4467 *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
|
|
|
4468 goto directionality;
|
|
|
4469 }
|
|
|
4470 if (c == '0') iso->esc = ISO_ESC_5_11_0;
|
|
|
4471 else if (c == '1') iso->esc = ISO_ESC_5_11_1;
|
|
|
4472 else if (c == '2') iso->esc = ISO_ESC_5_11_2;
|
|
|
4473 else return 0;
|
|
|
4474 goto not_done;
|
|
|
4475
|
|
|
4476 case ISO_ESC_5_11_0:
|
|
|
4477 if (c == ']')
|
|
|
4478 {
|
|
|
4479 *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
|
|
|
4480 goto directionality;
|
|
|
4481 }
|
|
|
4482 return 0;
|
|
|
4483
|
|
|
4484 case ISO_ESC_5_11_1:
|
|
|
4485 if (c == ']')
|
|
|
4486 {
|
|
|
4487 *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
|
|
|
4488 goto directionality;
|
|
|
4489 }
|
|
|
4490 return 0;
|
|
|
4491
|
|
|
4492 case ISO_ESC_5_11_2:
|
|
|
4493 if (c == ']')
|
|
|
4494 {
|
|
|
4495 *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L;
|
|
|
4496 goto directionality;
|
|
|
4497 }
|
|
|
4498 return 0;
|
|
|
4499
|
|
|
4500 directionality:
|
|
|
4501 iso->esc = ISO_ESC_DIRECTIONALITY;
|
|
|
4502 /* Various junk here to attempt to preserve the direction sequences
|
|
|
4503 literally in the text if they would otherwise be swallowed due
|
|
|
4504 to invalid designations that don't show up as actual charset
|
|
|
4505 changes in the text. */
|
|
|
4506 if (iso->invalid_switch_dir)
|
|
|
4507 {
|
|
|
4508 /* We already inserted a direction switch literally into the
|
|
|
4509 text. We assume (#### this may not be right) that the
|
|
|
4510 next direction switch is the one going the other way,
|
|
|
4511 and we need to output that literally as well. */
|
|
|
4512 iso->output_literally = 1;
|
|
|
4513 iso->invalid_switch_dir = 0;
|
|
|
4514 }
|
|
|
4515 else
|
|
|
4516 {
|
|
|
4517 int jj;
|
|
|
4518
|
|
|
4519 /* If we are in the thrall of an invalid designation,
|
|
|
4520 then stick the directionality sequence literally into the
|
|
|
4521 output stream so it ends up in the original text again. */
|
|
|
4522 for (jj = 0; jj < 4; jj++)
|
|
|
4523 if (iso->invalid_designated[jj])
|
|
|
4524 break;
|
|
|
4525 if (jj < 4)
|
|
|
4526 {
|
|
|
4527 iso->output_literally = 1;
|
|
|
4528 iso->invalid_switch_dir = 1;
|
|
|
4529 }
|
|
|
4530 else
|
|
|
4531 /* Indicate that we haven't yet seen a valid designation,
|
|
|
4532 so that if a switch-dir is directly followed by an
|
|
|
4533 invalid designation, both get inserted literally. */
|
|
|
4534 iso->switched_dir_and_no_valid_charset_yet = 1;
|
|
|
4535 }
|
|
|
4536 return 1;
|
|
|
4537
|
|
|
4538
|
|
|
4539 /**** designation ****/
|
|
|
4540
|
|
|
4541 case ISO_ESC_2_4:
|
|
|
4542 if (0x28 <= c && c <= 0x2F)
|
|
|
4543 {
|
|
|
4544 iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8);
|
|
|
4545 goto not_done;
|
|
|
4546 }
|
|
|
4547 if (0x40 <= c && c <= 0x42)
|
|
|
4548 {
|
|
|
4549 cs = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94, c,
|
|
|
4550 *flags & CODING_STATE_R2L ?
|
|
|
4551 CHARSET_RIGHT_TO_LEFT :
|
|
|
4552 CHARSET_LEFT_TO_RIGHT);
|
|
|
4553 reg = 0;
|
|
|
4554 goto designated;
|
|
|
4555 }
|
|
|
4556 return 0;
|
|
|
4557
|
|
|
4558 default:
|
|
|
4559 {
|
|
|
4560 int type =-1;
|
|
|
4561
|
|
|
4562 if (c < '0' || c > '~')
|
|
|
4563 return 0; /* bad final byte */
|
|
|
4564
|
|
|
4565 if (iso->esc >= ISO_ESC_2_8 &&
|
|
|
4566 iso->esc <= ISO_ESC_2_15)
|
|
|
4567 {
|
|
|
4568 type = ((iso->esc >= ISO_ESC_2_12) ?
|
|
|
4569 CHARSET_TYPE_96 : CHARSET_TYPE_94);
|
|
|
4570 reg = (iso->esc - ISO_ESC_2_8) & 3;
|
|
|
4571 }
|
|
|
4572 else if (iso->esc >= ISO_ESC_2_4_8 &&
|
|
|
4573 iso->esc <= ISO_ESC_2_4_15)
|
|
|
4574 {
|
|
|
4575 type = ((iso->esc >= ISO_ESC_2_4_12) ?
|
|
|
4576 CHARSET_TYPE_96X96 : CHARSET_TYPE_94X94);
|
|
|
4577 reg = (iso->esc - ISO_ESC_2_4_8) & 3;
|
|
|
4578 }
|
|
|
4579 else
|
|
|
4580 {
|
|
|
4581 /* Can this ever be reached? -slb */
|
|
|
4582 abort();
|
|
442
|
4583 return 0;
|
|
428
|
4584 }
|
|
|
4585
|
|
|
4586 cs = CHARSET_BY_ATTRIBUTES (type, c,
|
|
|
4587 *flags & CODING_STATE_R2L ?
|
|
|
4588 CHARSET_RIGHT_TO_LEFT :
|
|
|
4589 CHARSET_LEFT_TO_RIGHT);
|
|
|
4590 goto designated;
|
|
|
4591 }
|
|
|
4592 }
|
|
|
4593
|
|
|
4594 not_done:
|
|
|
4595 iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c;
|
|
|
4596 return -1;
|
|
|
4597
|
|
|
4598 single_shift:
|
|
|
4599 if (check_invalid_charsets && !CHARSETP (iso->charset[reg]))
|
|
|
4600 /* can't invoke something that ain't there. */
|
|
|
4601 return 0;
|
|
|
4602 iso->esc = ISO_ESC_SINGLE_SHIFT;
|
|
|
4603 *flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4604 if (reg == 2)
|
|
|
4605 *flags |= CODING_STATE_SS2;
|
|
|
4606 else
|
|
|
4607 *flags |= CODING_STATE_SS3;
|
|
|
4608 return 1;
|
|
|
4609
|
|
|
4610 locking_shift:
|
|
|
4611 if (check_invalid_charsets &&
|
|
|
4612 !CHARSETP (iso->charset[reg]))
|
|
|
4613 /* can't invoke something that ain't there. */
|
|
|
4614 return 0;
|
|
|
4615 if (half)
|
|
|
4616 iso->register_right = reg;
|
|
|
4617 else
|
|
|
4618 iso->register_left = reg;
|
|
|
4619 *flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4620 iso->esc = ISO_ESC_LOCKING_SHIFT;
|
|
|
4621 return 1;
|
|
|
4622
|
|
|
4623 designated:
|
|
|
4624 if (NILP (cs) && check_invalid_charsets)
|
|
|
4625 {
|
|
|
4626 iso->invalid_designated[reg] = 1;
|
|
|
4627 iso->charset[reg] = Vcharset_ascii;
|
|
|
4628 iso->esc = ISO_ESC_DESIGNATE;
|
|
|
4629 *flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4630 iso->output_literally = 1;
|
|
|
4631 if (iso->switched_dir_and_no_valid_charset_yet)
|
|
|
4632 {
|
|
|
4633 /* We encountered a switch-direction followed by an
|
|
|
4634 invalid designation. Ensure that the switch-direction
|
|
|
4635 gets outputted; otherwise it will probably get eaten
|
|
|
4636 when the text is written out again. */
|
|
|
4637 iso->switched_dir_and_no_valid_charset_yet = 0;
|
|
|
4638 iso->output_direction_sequence = 1;
|
|
|
4639 /* And make sure that the switch-dir going the other
|
|
|
4640 way gets outputted, as well. */
|
|
|
4641 iso->invalid_switch_dir = 1;
|
|
|
4642 }
|
|
|
4643 return 1;
|
|
|
4644 }
|
|
|
4645 /* This function is called with CODESYS equal to nil when
|
|
|
4646 doing coding-system detection. */
|
|
|
4647 if (!NILP (codesys))
|
|
|
4648 {
|
|
|
4649 charset_conversion_spec_dynarr *dyn =
|
|
|
4650 XCODING_SYSTEM (codesys)->iso2022.input_conv;
|
|
|
4651
|
|
|
4652 if (dyn)
|
|
|
4653 {
|
|
|
4654 int i;
|
|
|
4655
|
|
|
4656 for (i = 0; i < Dynarr_length (dyn); i++)
|
|
|
4657 {
|
|
|
4658 struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
|
|
|
4659 if (EQ (cs, spec->from_charset))
|
|
|
4660 cs = spec->to_charset;
|
|
|
4661 }
|
|
|
4662 }
|
|
|
4663 }
|
|
|
4664
|
|
|
4665 iso->charset[reg] = cs;
|
|
|
4666 iso->esc = ISO_ESC_DESIGNATE;
|
|
|
4667 *flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4668 if (iso->invalid_designated[reg])
|
|
|
4669 {
|
|
|
4670 iso->invalid_designated[reg] = 0;
|
|
|
4671 iso->output_literally = 1;
|
|
|
4672 }
|
|
|
4673 if (iso->switched_dir_and_no_valid_charset_yet)
|
|
|
4674 iso->switched_dir_and_no_valid_charset_yet = 0;
|
|
|
4675 return 1;
|
|
|
4676 }
|
|
|
4677
|
|
|
4678 static int
|
|
462
|
4679 detect_coding_iso2022 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
|
|
428
|
4680 {
|
|
|
4681 int mask;
|
|
|
4682
|
|
|
4683 /* #### There are serious deficiencies in the recognition mechanism
|
|
|
4684 here. This needs to be much smarter if it's going to cut it.
|
|
|
4685 The sequence "\xff\x0f" is currently detected as LOCK_SHIFT while
|
|
|
4686 it should be detected as Latin-1.
|
|
|
4687 All the ISO2022 stuff in this file should be synced up with the
|
|
|
4688 code from FSF Emacs-20.4, in which Mule should be more or less stable.
|
|
|
4689 Perhaps we should wait till R2L works in FSF Emacs? */
|
|
|
4690
|
|
|
4691 if (!st->iso2022.initted)
|
|
|
4692 {
|
|
|
4693 reset_iso2022 (Qnil, &st->iso2022.iso);
|
|
|
4694 st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK |
|
|
|
4695 CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
|
|
|
4696 CODING_CATEGORY_ISO_8_1_MASK |
|
|
|
4697 CODING_CATEGORY_ISO_8_2_MASK |
|
|
|
4698 CODING_CATEGORY_ISO_LOCK_SHIFT_MASK);
|
|
|
4699 st->iso2022.flags = 0;
|
|
|
4700 st->iso2022.high_byte_count = 0;
|
|
|
4701 st->iso2022.saw_single_shift = 0;
|
|
|
4702 st->iso2022.initted = 1;
|
|
|
4703 }
|
|
|
4704
|
|
|
4705 mask = st->iso2022.mask;
|
|
|
4706
|
|
|
4707 while (n--)
|
|
|
4708 {
|
|
444
|
4709 unsigned char c = *(unsigned char *)src++;
|
|
428
|
4710 if (c >= 0xA0)
|
|
|
4711 {
|
|
|
4712 mask &= ~CODING_CATEGORY_ISO_7_MASK;
|
|
|
4713 st->iso2022.high_byte_count++;
|
|
|
4714 }
|
|
|
4715 else
|
|
|
4716 {
|
|
|
4717 if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift)
|
|
|
4718 {
|
|
|
4719 if (st->iso2022.high_byte_count & 1)
|
|
|
4720 /* odd number of high bytes; assume not iso-8-2 */
|
|
|
4721 mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
|
|
|
4722 }
|
|
|
4723 st->iso2022.high_byte_count = 0;
|
|
|
4724 st->iso2022.saw_single_shift = 0;
|
|
|
4725 if (c > 0x80)
|
|
|
4726 mask &= ~CODING_CATEGORY_ISO_7_MASK;
|
|
|
4727 }
|
|
|
4728 if (!(st->iso2022.flags & CODING_STATE_ESCAPE)
|
|
|
4729 && (BYTE_C0_P (c) || BYTE_C1_P (c)))
|
|
|
4730 { /* control chars */
|
|
|
4731 switch (c)
|
|
|
4732 {
|
|
|
4733 /* Allow and ignore control characters that you might
|
|
|
4734 reasonably see in a text file */
|
|
|
4735 case '\r':
|
|
|
4736 case '\n':
|
|
|
4737 case '\t':
|
|
|
4738 case 7: /* bell */
|
|
|
4739 case 8: /* backspace */
|
|
|
4740 case 11: /* vertical tab */
|
|
|
4741 case 12: /* form feed */
|
|
|
4742 case 26: /* MS-DOS C-z junk */
|
|
|
4743 case 31: /* '^_' -- for info */
|
|
|
4744 goto label_continue_loop;
|
|
|
4745
|
|
|
4746 default:
|
|
|
4747 break;
|
|
|
4748 }
|
|
|
4749 }
|
|
|
4750
|
|
|
4751 if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c)
|
|
|
4752 || BYTE_C1_P (c))
|
|
|
4753 {
|
|
|
4754 if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c,
|
|
|
4755 &st->iso2022.flags, 0))
|
|
|
4756 {
|
|
|
4757 switch (st->iso2022.iso.esc)
|
|
|
4758 {
|
|
|
4759 case ISO_ESC_DESIGNATE:
|
|
|
4760 mask &= ~CODING_CATEGORY_ISO_8_1_MASK;
|
|
|
4761 mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
|
|
|
4762 break;
|
|
|
4763 case ISO_ESC_LOCKING_SHIFT:
|
|
|
4764 mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK;
|
|
|
4765 goto ran_out_of_chars;
|
|
|
4766 case ISO_ESC_SINGLE_SHIFT:
|
|
|
4767 mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK;
|
|
|
4768 st->iso2022.saw_single_shift = 1;
|
|
|
4769 break;
|
|
|
4770 default:
|
|
|
4771 break;
|
|
|
4772 }
|
|
|
4773 }
|
|
|
4774 else
|
|
|
4775 {
|
|
|
4776 mask = 0;
|
|
|
4777 goto ran_out_of_chars;
|
|
|
4778 }
|
|
|
4779 }
|
|
|
4780 label_continue_loop:;
|
|
|
4781 }
|
|
|
4782
|
|
|
4783 ran_out_of_chars:
|
|
|
4784
|
|
|
4785 return mask;
|
|
|
4786 }
|
|
|
4787
|
|
|
4788 static int
|
|
|
4789 postprocess_iso2022_mask (int mask)
|
|
|
4790 {
|
|
|
4791 /* #### kind of cheesy */
|
|
|
4792 /* If seven-bit ISO is allowed, then assume that the encoding is
|
|
|
4793 entirely seven-bit and turn off the eight-bit ones. */
|
|
|
4794 if (mask & CODING_CATEGORY_ISO_7_MASK)
|
|
|
4795 mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
|
|
|
4796 CODING_CATEGORY_ISO_8_1_MASK |
|
|
|
4797 CODING_CATEGORY_ISO_8_2_MASK);
|
|
|
4798 return mask;
|
|
|
4799 }
|
|
|
4800
|
|
|
4801 /* If FLAGS is a null pointer or specifies right-to-left motion,
|
|
|
4802 output a switch-dir-to-left-to-right sequence to DST.
|
|
|
4803 Also update FLAGS if it is not a null pointer.
|
|
|
4804 If INTERNAL_P is set, we are outputting in internal format and
|
|
|
4805 need to handle the CSI differently. */
|
|
|
4806
|
|
|
4807 static void
|
|
|
4808 restore_left_to_right_direction (Lisp_Coding_System *codesys,
|
|
|
4809 unsigned_char_dynarr *dst,
|
|
|
4810 unsigned int *flags,
|
|
|
4811 int internal_p)
|
|
|
4812 {
|
|
|
4813 if (!flags || (*flags & CODING_STATE_R2L))
|
|
|
4814 {
|
|
|
4815 if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
|
|
|
4816 {
|
|
|
4817 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
4818 Dynarr_add (dst, '[');
|
|
|
4819 }
|
|
|
4820 else if (internal_p)
|
|
|
4821 DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
|
|
|
4822 else
|
|
|
4823 Dynarr_add (dst, ISO_CODE_CSI);
|
|
|
4824 Dynarr_add (dst, '0');
|
|
|
4825 Dynarr_add (dst, ']');
|
|
|
4826 if (flags)
|
|
|
4827 *flags &= ~CODING_STATE_R2L;
|
|
|
4828 }
|
|
|
4829 }
|
|
|
4830
|
|
|
4831 /* If FLAGS is a null pointer or specifies a direction different from
|
|
|
4832 DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or
|
|
|
4833 CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape
|
|
|
4834 sequence to DST. Also update FLAGS if it is not a null pointer.
|
|
|
4835 If INTERNAL_P is set, we are outputting in internal format and
|
|
|
4836 need to handle the CSI differently. */
|
|
|
4837
|
|
|
4838 static void
|
|
|
4839 ensure_correct_direction (int direction, Lisp_Coding_System *codesys,
|
|
|
4840 unsigned_char_dynarr *dst, unsigned int *flags,
|
|
|
4841 int internal_p)
|
|
|
4842 {
|
|
|
4843 if ((!flags || (*flags & CODING_STATE_R2L)) &&
|
|
|
4844 direction == CHARSET_LEFT_TO_RIGHT)
|
|
|
4845 restore_left_to_right_direction (codesys, dst, flags, internal_p);
|
|
|
4846 else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys)
|
|
|
4847 && (!flags || !(*flags & CODING_STATE_R2L)) &&
|
|
|
4848 direction == CHARSET_RIGHT_TO_LEFT)
|
|
|
4849 {
|
|
|
4850 if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
|
|
|
4851 {
|
|
|
4852 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
4853 Dynarr_add (dst, '[');
|
|
|
4854 }
|
|
|
4855 else if (internal_p)
|
|
|
4856 DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
|
|
|
4857 else
|
|
|
4858 Dynarr_add (dst, ISO_CODE_CSI);
|
|
|
4859 Dynarr_add (dst, '2');
|
|
|
4860 Dynarr_add (dst, ']');
|
|
|
4861 if (flags)
|
|
|
4862 *flags |= CODING_STATE_R2L;
|
|
|
4863 }
|
|
|
4864 }
|
|
|
4865
|
|
|
4866 /* Convert ISO2022-format data to internal format. */
|
|
|
4867
|
|
|
4868 static void
|
|
444
|
4869 decode_coding_iso2022 (Lstream *decoding, const Extbyte *src,
|
|
462
|
4870 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
4871 {
|
|
|
4872 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
4873 unsigned int flags = str->flags;
|
|
|
4874 unsigned int ch = str->ch;
|
|
|
4875 eol_type_t eol_type = str->eol_type;
|
|
|
4876 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4877 unsigned_char_dynarr *real_dst = dst;
|
|
|
4878 #endif
|
|
|
4879 Lisp_Object coding_system;
|
|
|
4880
|
|
|
4881 XSETCODING_SYSTEM (coding_system, str->codesys);
|
|
|
4882
|
|
|
4883 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4884 if (flags & CODING_STATE_COMPOSITE)
|
|
|
4885 dst = str->iso2022.composite_chars;
|
|
|
4886 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
4887
|
|
|
4888 while (n--)
|
|
|
4889 {
|
|
444
|
4890 unsigned char c = *(unsigned char *)src++;
|
|
428
|
4891 if (flags & CODING_STATE_ESCAPE)
|
|
|
4892 { /* Within ESC sequence */
|
|
|
4893 int retval = parse_iso2022_esc (coding_system, &str->iso2022,
|
|
|
4894 c, &flags, 1);
|
|
|
4895
|
|
|
4896 if (retval)
|
|
|
4897 {
|
|
|
4898 switch (str->iso2022.esc)
|
|
|
4899 {
|
|
|
4900 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
4901 case ISO_ESC_START_COMPOSITE:
|
|
|
4902 if (str->iso2022.composite_chars)
|
|
|
4903 Dynarr_reset (str->iso2022.composite_chars);
|
|
|
4904 else
|
|
|
4905 str->iso2022.composite_chars = Dynarr_new (unsigned_char);
|
|
|
4906 dst = str->iso2022.composite_chars;
|
|
|
4907 break;
|
|
|
4908 case ISO_ESC_END_COMPOSITE:
|
|
|
4909 {
|
|
|
4910 Bufbyte comstr[MAX_EMCHAR_LEN];
|
|
|
4911 Bytecount len;
|
|
|
4912 Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0),
|
|
|
4913 Dynarr_length (dst));
|
|
|
4914 dst = real_dst;
|
|
|
4915 len = set_charptr_emchar (comstr, emch);
|
|
|
4916 Dynarr_add_many (dst, comstr, len);
|
|
|
4917 break;
|
|
|
4918 }
|
|
|
4919 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
4920
|
|
|
4921 case ISO_ESC_LITERAL:
|
|
|
4922 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
4923 break;
|
|
|
4924
|
|
|
4925 default:
|
|
|
4926 /* Everything else handled already */
|
|
|
4927 break;
|
|
|
4928 }
|
|
|
4929 }
|
|
|
4930
|
|
|
4931 /* Attempted error recovery. */
|
|
|
4932 if (str->iso2022.output_direction_sequence)
|
|
|
4933 ensure_correct_direction (flags & CODING_STATE_R2L ?
|
|
|
4934 CHARSET_RIGHT_TO_LEFT :
|
|
|
4935 CHARSET_LEFT_TO_RIGHT,
|
|
|
4936 str->codesys, dst, 0, 1);
|
|
|
4937 /* More error recovery. */
|
|
|
4938 if (!retval || str->iso2022.output_literally)
|
|
|
4939 {
|
|
|
4940 /* Output the (possibly invalid) sequence */
|
|
|
4941 int i;
|
|
|
4942 for (i = 0; i < str->iso2022.esc_bytes_index; i++)
|
|
|
4943 DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst);
|
|
|
4944 flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4945 if (!retval)
|
|
|
4946 n++, src--;/* Repeat the loop with the same character. */
|
|
|
4947 else
|
|
|
4948 {
|
|
|
4949 /* No sense in reprocessing the final byte of the
|
|
|
4950 escape sequence; it could mess things up anyway.
|
|
|
4951 Just add it now. */
|
|
|
4952 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
4953 }
|
|
|
4954 }
|
|
|
4955 ch = 0;
|
|
|
4956 }
|
|
|
4957 else if (BYTE_C0_P (c) || BYTE_C1_P (c))
|
|
|
4958 { /* Control characters */
|
|
|
4959
|
|
|
4960 /***** Error-handling *****/
|
|
|
4961
|
|
|
4962 /* If we were in the middle of a character, dump out the
|
|
|
4963 partial character. */
|
|
|
4964 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
4965
|
|
|
4966 /* If we just saw a single-shift character, dump it out.
|
|
|
4967 This may dump out the wrong sort of single-shift character,
|
|
|
4968 but least it will give an indication that something went
|
|
|
4969 wrong. */
|
|
|
4970 if (flags & CODING_STATE_SS2)
|
|
|
4971 {
|
|
|
4972 DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst);
|
|
|
4973 flags &= ~CODING_STATE_SS2;
|
|
|
4974 }
|
|
|
4975 if (flags & CODING_STATE_SS3)
|
|
|
4976 {
|
|
|
4977 DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst);
|
|
|
4978 flags &= ~CODING_STATE_SS3;
|
|
|
4979 }
|
|
|
4980
|
|
|
4981 /***** Now handle the control characters. *****/
|
|
|
4982
|
|
|
4983 /* Handle CR/LF */
|
|
|
4984 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
4985
|
|
|
4986 flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
4987
|
|
|
4988 if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1))
|
|
|
4989 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
4990 }
|
|
|
4991 else
|
|
|
4992 { /* Graphic characters */
|
|
|
4993 Lisp_Object charset;
|
|
|
4994 int lb;
|
|
|
4995 int reg;
|
|
|
4996
|
|
|
4997 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
4998
|
|
|
4999 /* Now determine the charset. */
|
|
|
5000 reg = ((flags & CODING_STATE_SS2) ? 2
|
|
|
5001 : (flags & CODING_STATE_SS3) ? 3
|
|
|
5002 : !BYTE_ASCII_P (c) ? str->iso2022.register_right
|
|
|
5003 : str->iso2022.register_left);
|
|
|
5004 charset = str->iso2022.charset[reg];
|
|
|
5005
|
|
|
5006 /* Error checking: */
|
|
|
5007 if (! CHARSETP (charset)
|
|
|
5008 || str->iso2022.invalid_designated[reg]
|
|
|
5009 || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL)
|
|
|
5010 && XCHARSET_CHARS (charset) == 94))
|
|
|
5011 /* Mrmph. We are trying to invoke a register that has no
|
|
|
5012 or an invalid charset in it, or trying to add a character
|
|
|
5013 outside the range of the charset. Insert that char literally
|
|
|
5014 to preserve it for the output. */
|
|
|
5015 {
|
|
|
5016 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
5017 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
5018 }
|
|
|
5019
|
|
|
5020 else
|
|
|
5021 {
|
|
|
5022 /* Things are probably hunky-dorey. */
|
|
|
5023
|
|
|
5024 /* Fetch reverse charset, maybe. */
|
|
|
5025 if (((flags & CODING_STATE_R2L) &&
|
|
|
5026 XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT)
|
|
|
5027 ||
|
|
|
5028 (!(flags & CODING_STATE_R2L) &&
|
|
|
5029 XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT))
|
|
|
5030 {
|
|
|
5031 Lisp_Object new_charset =
|
|
|
5032 XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
|
|
|
5033 if (!NILP (new_charset))
|
|
|
5034 charset = new_charset;
|
|
|
5035 }
|
|
|
5036
|
|
|
5037 lb = XCHARSET_LEADING_BYTE (charset);
|
|
|
5038 switch (XCHARSET_REP_BYTES (charset))
|
|
|
5039 {
|
|
|
5040 case 1: /* ASCII */
|
|
|
5041 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
5042 Dynarr_add (dst, c & 0x7F);
|
|
|
5043 break;
|
|
|
5044
|
|
|
5045 case 2: /* one-byte official */
|
|
|
5046 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
5047 Dynarr_add (dst, lb);
|
|
|
5048 Dynarr_add (dst, c | 0x80);
|
|
|
5049 break;
|
|
|
5050
|
|
|
5051 case 3: /* one-byte private or two-byte official */
|
|
|
5052 if (XCHARSET_PRIVATE_P (charset))
|
|
|
5053 {
|
|
|
5054 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
5055 Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1);
|
|
|
5056 Dynarr_add (dst, lb);
|
|
|
5057 Dynarr_add (dst, c | 0x80);
|
|
|
5058 }
|
|
|
5059 else
|
|
|
5060 {
|
|
|
5061 if (ch)
|
|
|
5062 {
|
|
|
5063 Dynarr_add (dst, lb);
|
|
|
5064 Dynarr_add (dst, ch | 0x80);
|
|
|
5065 Dynarr_add (dst, c | 0x80);
|
|
|
5066 ch = 0;
|
|
|
5067 }
|
|
|
5068 else
|
|
|
5069 ch = c;
|
|
|
5070 }
|
|
|
5071 break;
|
|
|
5072
|
|
|
5073 default: /* two-byte private */
|
|
|
5074 if (ch)
|
|
|
5075 {
|
|
|
5076 Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2);
|
|
|
5077 Dynarr_add (dst, lb);
|
|
|
5078 Dynarr_add (dst, ch | 0x80);
|
|
|
5079 Dynarr_add (dst, c | 0x80);
|
|
|
5080 ch = 0;
|
|
|
5081 }
|
|
|
5082 else
|
|
|
5083 ch = c;
|
|
|
5084 }
|
|
|
5085 }
|
|
|
5086
|
|
|
5087 if (!ch)
|
|
|
5088 flags &= CODING_STATE_ISO2022_LOCK;
|
|
|
5089 }
|
|
|
5090
|
|
|
5091 label_continue_loop:;
|
|
|
5092 }
|
|
|
5093
|
|
|
5094 if (flags & CODING_STATE_END)
|
|
|
5095 DECODE_OUTPUT_PARTIAL_CHAR (ch);
|
|
|
5096
|
|
|
5097 str->flags = flags;
|
|
|
5098 str->ch = ch;
|
|
|
5099 }
|
|
|
5100
|
|
|
5101
|
|
|
5102 /***** ISO2022 encoder *****/
|
|
|
5103
|
|
|
5104 /* Designate CHARSET into register REG. */
|
|
|
5105
|
|
|
5106 static void
|
|
|
5107 iso2022_designate (Lisp_Object charset, unsigned char reg,
|
|
|
5108 struct encoding_stream *str, unsigned_char_dynarr *dst)
|
|
|
5109 {
|
|
442
|
5110 static const char inter94[] = "()*+";
|
|
|
5111 static const char inter96[] = ",-./";
|
|
428
|
5112 unsigned int type;
|
|
|
5113 unsigned char final;
|
|
|
5114 Lisp_Object old_charset = str->iso2022.charset[reg];
|
|
|
5115
|
|
|
5116 str->iso2022.charset[reg] = charset;
|
|
|
5117 if (!CHARSETP (charset))
|
|
|
5118 /* charset might be an initial nil or t. */
|
|
|
5119 return;
|
|
|
5120 type = XCHARSET_TYPE (charset);
|
|
|
5121 final = XCHARSET_FINAL (charset);
|
|
|
5122 if (!str->iso2022.force_charset_on_output[reg] &&
|
|
|
5123 CHARSETP (old_charset) &&
|
|
|
5124 XCHARSET_TYPE (old_charset) == type &&
|
|
|
5125 XCHARSET_FINAL (old_charset) == final)
|
|
|
5126 return;
|
|
|
5127
|
|
|
5128 str->iso2022.force_charset_on_output[reg] = 0;
|
|
|
5129
|
|
|
5130 {
|
|
|
5131 charset_conversion_spec_dynarr *dyn =
|
|
|
5132 str->codesys->iso2022.output_conv;
|
|
|
5133
|
|
|
5134 if (dyn)
|
|
|
5135 {
|
|
|
5136 int i;
|
|
|
5137
|
|
|
5138 for (i = 0; i < Dynarr_length (dyn); i++)
|
|
|
5139 {
|
|
|
5140 struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
|
|
|
5141 if (EQ (charset, spec->from_charset))
|
|
|
5142 charset = spec->to_charset;
|
|
|
5143 }
|
|
|
5144 }
|
|
|
5145 }
|
|
|
5146
|
|
|
5147 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5148 switch (type)
|
|
|
5149 {
|
|
|
5150 case CHARSET_TYPE_94:
|
|
|
5151 Dynarr_add (dst, inter94[reg]);
|
|
|
5152 break;
|
|
|
5153 case CHARSET_TYPE_96:
|
|
|
5154 Dynarr_add (dst, inter96[reg]);
|
|
|
5155 break;
|
|
|
5156 case CHARSET_TYPE_94X94:
|
|
|
5157 Dynarr_add (dst, '$');
|
|
|
5158 if (reg != 0
|
|
|
5159 || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys))
|
|
|
5160 || final < '@'
|
|
|
5161 || final > 'B')
|
|
|
5162 Dynarr_add (dst, inter94[reg]);
|
|
|
5163 break;
|
|
|
5164 case CHARSET_TYPE_96X96:
|
|
|
5165 Dynarr_add (dst, '$');
|
|
|
5166 Dynarr_add (dst, inter96[reg]);
|
|
|
5167 break;
|
|
|
5168 }
|
|
|
5169 Dynarr_add (dst, final);
|
|
|
5170 }
|
|
|
5171
|
|
|
5172 static void
|
|
|
5173 ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst)
|
|
|
5174 {
|
|
|
5175 if (str->iso2022.register_left != 0)
|
|
|
5176 {
|
|
|
5177 Dynarr_add (dst, ISO_CODE_SI);
|
|
|
5178 str->iso2022.register_left = 0;
|
|
|
5179 }
|
|
|
5180 }
|
|
|
5181
|
|
|
5182 static void
|
|
|
5183 ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst)
|
|
|
5184 {
|
|
|
5185 if (str->iso2022.register_left != 1)
|
|
|
5186 {
|
|
|
5187 Dynarr_add (dst, ISO_CODE_SO);
|
|
|
5188 str->iso2022.register_left = 1;
|
|
|
5189 }
|
|
|
5190 }
|
|
|
5191
|
|
|
5192 /* Convert internally-formatted data to ISO2022 format. */
|
|
|
5193
|
|
|
5194 static void
|
|
444
|
5195 encode_coding_iso2022 (Lstream *encoding, const Bufbyte *src,
|
|
462
|
5196 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
5197 {
|
|
|
5198 unsigned char charmask, c;
|
|
|
5199 unsigned char char_boundary;
|
|
|
5200 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
5201 unsigned int flags = str->flags;
|
|
|
5202 unsigned int ch = str->ch;
|
|
|
5203 Lisp_Coding_System *codesys = str->codesys;
|
|
|
5204 eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
|
|
|
5205 int i;
|
|
|
5206 Lisp_Object charset;
|
|
|
5207 int half;
|
|
|
5208
|
|
|
5209 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
5210 /* flags for handling composite chars. We do a little switcharoo
|
|
|
5211 on the source while we're outputting the composite char. */
|
|
|
5212 unsigned int saved_n = 0;
|
|
442
|
5213 const unsigned char *saved_src = NULL;
|
|
428
|
5214 int in_composite = 0;
|
|
|
5215 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
5216
|
|
|
5217 char_boundary = str->iso2022.current_char_boundary;
|
|
|
5218 charset = str->iso2022.current_charset;
|
|
|
5219 half = str->iso2022.current_half;
|
|
|
5220
|
|
|
5221 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
5222 back_to_square_n:
|
|
|
5223 #endif
|
|
|
5224 while (n--)
|
|
|
5225 {
|
|
|
5226 c = *src++;
|
|
|
5227
|
|
|
5228 if (BYTE_ASCII_P (c))
|
|
|
5229 { /* Processing ASCII character */
|
|
|
5230 ch = 0;
|
|
|
5231
|
|
|
5232 restore_left_to_right_direction (codesys, dst, &flags, 0);
|
|
|
5233
|
|
|
5234 /* Make sure G0 contains ASCII */
|
|
|
5235 if ((c > ' ' && c < ISO_CODE_DEL) ||
|
|
|
5236 !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys))
|
|
|
5237 {
|
|
|
5238 ensure_normal_shift (str, dst);
|
|
|
5239 iso2022_designate (Vcharset_ascii, 0, str, dst);
|
|
|
5240 }
|
|
|
5241
|
|
|
5242 /* If necessary, restore everything to the default state
|
|
|
5243 at end-of-line */
|
|
|
5244 if (c == '\n' &&
|
|
|
5245 !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys)))
|
|
|
5246 {
|
|
|
5247 restore_left_to_right_direction (codesys, dst, &flags, 0);
|
|
|
5248
|
|
|
5249 ensure_normal_shift (str, dst);
|
|
|
5250
|
|
|
5251 for (i = 0; i < 4; i++)
|
|
|
5252 {
|
|
|
5253 Lisp_Object initial_charset =
|
|
|
5254 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
|
|
|
5255 iso2022_designate (initial_charset, i, str, dst);
|
|
|
5256 }
|
|
|
5257 }
|
|
|
5258 if (c == '\n')
|
|
|
5259 {
|
|
|
5260 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
|
|
|
5261 Dynarr_add (dst, '\r');
|
|
|
5262 if (eol_type != EOL_CR)
|
|
|
5263 Dynarr_add (dst, c);
|
|
|
5264 }
|
|
|
5265 else
|
|
|
5266 {
|
|
|
5267 if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
|
|
|
5268 && fit_to_be_escape_quoted (c))
|
|
|
5269 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5270 Dynarr_add (dst, c);
|
|
|
5271 }
|
|
|
5272 char_boundary = 1;
|
|
|
5273 }
|
|
|
5274
|
|
|
5275 else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch))
|
|
|
5276 { /* Processing Leading Byte */
|
|
|
5277 ch = 0;
|
|
|
5278 charset = CHARSET_BY_LEADING_BYTE (c);
|
|
|
5279 if (LEADING_BYTE_PREFIX_P(c))
|
|
|
5280 ch = c;
|
|
|
5281 else if (!EQ (charset, Vcharset_control_1)
|
|
|
5282 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
5283 && !EQ (charset, Vcharset_composite)
|
|
|
5284 #endif
|
|
|
5285 )
|
|
|
5286 {
|
|
|
5287 int reg;
|
|
|
5288
|
|
|
5289 ensure_correct_direction (XCHARSET_DIRECTION (charset),
|
|
|
5290 codesys, dst, &flags, 0);
|
|
|
5291
|
|
|
5292 /* Now determine which register to use. */
|
|
|
5293 reg = -1;
|
|
|
5294 for (i = 0; i < 4; i++)
|
|
|
5295 {
|
|
|
5296 if (EQ (charset, str->iso2022.charset[i]) ||
|
|
|
5297 EQ (charset,
|
|
|
5298 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)))
|
|
|
5299 {
|
|
|
5300 reg = i;
|
|
|
5301 break;
|
|
|
5302 }
|
|
|
5303 }
|
|
|
5304
|
|
|
5305 if (reg == -1)
|
|
|
5306 {
|
|
|
5307 if (XCHARSET_GRAPHIC (charset) != 0)
|
|
|
5308 {
|
|
|
5309 if (!NILP (str->iso2022.charset[1]) &&
|
|
|
5310 (!CODING_SYSTEM_ISO2022_SEVEN (codesys) ||
|
|
|
5311 CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys)))
|
|
|
5312 reg = 1;
|
|
|
5313 else if (!NILP (str->iso2022.charset[2]))
|
|
|
5314 reg = 2;
|
|
|
5315 else if (!NILP (str->iso2022.charset[3]))
|
|
|
5316 reg = 3;
|
|
|
5317 else
|
|
|
5318 reg = 0;
|
|
|
5319 }
|
|
|
5320 else
|
|
|
5321 reg = 0;
|
|
|
5322 }
|
|
|
5323
|
|
|
5324 iso2022_designate (charset, reg, str, dst);
|
|
|
5325
|
|
|
5326 /* Now invoke that register. */
|
|
|
5327 switch (reg)
|
|
|
5328 {
|
|
|
5329 case 0:
|
|
|
5330 ensure_normal_shift (str, dst);
|
|
|
5331 half = 0;
|
|
|
5332 break;
|
|
|
5333
|
|
|
5334 case 1:
|
|
|
5335 if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
|
|
|
5336 {
|
|
|
5337 ensure_shift_out (str, dst);
|
|
|
5338 half = 0;
|
|
|
5339 }
|
|
|
5340 else
|
|
|
5341 half = 1;
|
|
|
5342 break;
|
|
|
5343
|
|
|
5344 case 2:
|
|
|
5345 if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
|
|
|
5346 {
|
|
|
5347 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5348 Dynarr_add (dst, 'N');
|
|
|
5349 half = 0;
|
|
|
5350 }
|
|
|
5351 else
|
|
|
5352 {
|
|
|
5353 Dynarr_add (dst, ISO_CODE_SS2);
|
|
|
5354 half = 1;
|
|
|
5355 }
|
|
|
5356 break;
|
|
|
5357
|
|
|
5358 case 3:
|
|
|
5359 if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
|
|
|
5360 {
|
|
|
5361 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5362 Dynarr_add (dst, 'O');
|
|
|
5363 half = 0;
|
|
|
5364 }
|
|
|
5365 else
|
|
|
5366 {
|
|
|
5367 Dynarr_add (dst, ISO_CODE_SS3);
|
|
|
5368 half = 1;
|
|
|
5369 }
|
|
|
5370 break;
|
|
|
5371
|
|
|
5372 default:
|
|
|
5373 abort ();
|
|
|
5374 }
|
|
|
5375 }
|
|
|
5376 char_boundary = 0;
|
|
|
5377 }
|
|
|
5378 else
|
|
|
5379 { /* Processing Non-ASCII character */
|
|
|
5380 charmask = (half == 0 ? 0x7F : 0xFF);
|
|
|
5381 char_boundary = 1;
|
|
|
5382 if (EQ (charset, Vcharset_control_1))
|
|
|
5383 {
|
|
|
5384 if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
|
|
|
5385 && fit_to_be_escape_quoted (c))
|
|
|
5386 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5387 /* you asked for it ... */
|
|
|
5388 Dynarr_add (dst, c - 0x20);
|
|
|
5389 }
|
|
|
5390 else
|
|
|
5391 {
|
|
|
5392 switch (XCHARSET_REP_BYTES (charset))
|
|
|
5393 {
|
|
|
5394 case 2:
|
|
|
5395 Dynarr_add (dst, c & charmask);
|
|
|
5396 break;
|
|
|
5397 case 3:
|
|
|
5398 if (XCHARSET_PRIVATE_P (charset))
|
|
|
5399 {
|
|
|
5400 Dynarr_add (dst, c & charmask);
|
|
|
5401 ch = 0;
|
|
|
5402 }
|
|
|
5403 else if (ch)
|
|
|
5404 {
|
|
|
5405 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
5406 if (EQ (charset, Vcharset_composite))
|
|
|
5407 {
|
|
|
5408 if (in_composite)
|
|
|
5409 {
|
|
|
5410 /* #### Bother! We don't know how to
|
|
|
5411 handle this yet. */
|
|
|
5412 Dynarr_add (dst, '~');
|
|
|
5413 }
|
|
|
5414 else
|
|
|
5415 {
|
|
|
5416 Emchar emch = MAKE_CHAR (Vcharset_composite,
|
|
|
5417 ch & 0x7F, c & 0x7F);
|
|
|
5418 Lisp_Object lstr = composite_char_string (emch);
|
|
|
5419 saved_n = n;
|
|
|
5420 saved_src = src;
|
|
|
5421 in_composite = 1;
|
|
|
5422 src = XSTRING_DATA (lstr);
|
|
|
5423 n = XSTRING_LENGTH (lstr);
|
|
|
5424 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5425 Dynarr_add (dst, '0'); /* start composing */
|
|
|
5426 }
|
|
|
5427 }
|
|
|
5428 else
|
|
|
5429 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
5430 {
|
|
|
5431 Dynarr_add (dst, ch & charmask);
|
|
|
5432 Dynarr_add (dst, c & charmask);
|
|
|
5433 }
|
|
|
5434 ch = 0;
|
|
|
5435 }
|
|
|
5436 else
|
|
|
5437 {
|
|
|
5438 ch = c;
|
|
|
5439 char_boundary = 0;
|
|
|
5440 }
|
|
|
5441 break;
|
|
|
5442 case 4:
|
|
|
5443 if (ch)
|
|
|
5444 {
|
|
|
5445 Dynarr_add (dst, ch & charmask);
|
|
|
5446 Dynarr_add (dst, c & charmask);
|
|
|
5447 ch = 0;
|
|
|
5448 }
|
|
|
5449 else
|
|
|
5450 {
|
|
|
5451 ch = c;
|
|
|
5452 char_boundary = 0;
|
|
|
5453 }
|
|
|
5454 break;
|
|
|
5455 default:
|
|
|
5456 abort ();
|
|
|
5457 }
|
|
|
5458 }
|
|
|
5459 }
|
|
|
5460 }
|
|
|
5461
|
|
|
5462 #ifdef ENABLE_COMPOSITE_CHARS
|
|
|
5463 if (in_composite)
|
|
|
5464 {
|
|
|
5465 n = saved_n;
|
|
|
5466 src = saved_src;
|
|
|
5467 in_composite = 0;
|
|
|
5468 Dynarr_add (dst, ISO_CODE_ESC);
|
|
|
5469 Dynarr_add (dst, '1'); /* end composing */
|
|
|
5470 goto back_to_square_n; /* Wheeeeeeeee ..... */
|
|
|
5471 }
|
|
|
5472 #endif /* ENABLE_COMPOSITE_CHARS */
|
|
|
5473
|
|
|
5474 if (char_boundary && flags & CODING_STATE_END)
|
|
|
5475 {
|
|
|
5476 restore_left_to_right_direction (codesys, dst, &flags, 0);
|
|
|
5477 ensure_normal_shift (str, dst);
|
|
|
5478 for (i = 0; i < 4; i++)
|
|
|
5479 {
|
|
|
5480 Lisp_Object initial_charset =
|
|
|
5481 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
|
|
|
5482 iso2022_designate (initial_charset, i, str, dst);
|
|
|
5483 }
|
|
|
5484 }
|
|
|
5485
|
|
|
5486 str->flags = flags;
|
|
|
5487 str->ch = ch;
|
|
|
5488 str->iso2022.current_char_boundary = char_boundary;
|
|
|
5489 str->iso2022.current_charset = charset;
|
|
|
5490 str->iso2022.current_half = half;
|
|
|
5491
|
|
|
5492 /* Verbum caro factum est! */
|
|
|
5493 }
|
|
|
5494 #endif /* MULE */
|
|
|
5495
|
|
|
5496 /************************************************************************/
|
|
|
5497 /* No-conversion methods */
|
|
|
5498 /************************************************************************/
|
|
|
5499
|
|
|
5500 /* This is used when reading in "binary" files -- i.e. files that may
|
|
|
5501 contain all 256 possible byte values and that are not to be
|
|
|
5502 interpreted as being in any particular decoding. */
|
|
|
5503 static void
|
|
444
|
5504 decode_coding_no_conversion (Lstream *decoding, const Extbyte *src,
|
|
462
|
5505 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
5506 {
|
|
|
5507 struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
|
|
|
5508 unsigned int flags = str->flags;
|
|
|
5509 unsigned int ch = str->ch;
|
|
|
5510 eol_type_t eol_type = str->eol_type;
|
|
|
5511
|
|
|
5512 while (n--)
|
|
|
5513 {
|
|
444
|
5514 unsigned char c = *(unsigned char *)src++;
|
|
428
|
5515
|
|
|
5516 DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
|
|
|
5517 DECODE_ADD_BINARY_CHAR (c, dst);
|
|
|
5518 label_continue_loop:;
|
|
|
5519 }
|
|
|
5520
|
|
|
5521 DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
|
|
|
5522
|
|
|
5523 str->flags = flags;
|
|
|
5524 str->ch = ch;
|
|
|
5525 }
|
|
|
5526
|
|
|
5527 static void
|
|
444
|
5528 encode_coding_no_conversion (Lstream *encoding, const Bufbyte *src,
|
|
462
|
5529 unsigned_char_dynarr *dst, Lstream_data_count n)
|
|
428
|
5530 {
|
|
|
5531 unsigned char c;
|
|
|
5532 struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
|
|
|
5533 unsigned int flags = str->flags;
|
|
|
5534 unsigned int ch = str->ch;
|
|
|
5535 eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
|
|
|
5536
|
|
|
5537 while (n--)
|
|
|
5538 {
|
|
|
5539 c = *src++;
|
|
|
5540 if (c == '\n')
|
|
|
5541 {
|
|
|
5542 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
|
|
|
5543 Dynarr_add (dst, '\r');
|
|
|
5544 if (eol_type != EOL_CR)
|
|
|
5545 Dynarr_add (dst, '\n');
|
|
|
5546 ch = 0;
|
|
|
5547 }
|
|
|
5548 else if (BYTE_ASCII_P (c))
|
|
|
5549 {
|
|
|
5550 assert (ch == 0);
|
|
|
5551 Dynarr_add (dst, c);
|
|
|
5552 }
|
|
|
5553 else if (BUFBYTE_LEADING_BYTE_P (c))
|
|
|
5554 {
|
|
|
5555 assert (ch == 0);
|
|
|
5556 if (c == LEADING_BYTE_LATIN_ISO8859_1 ||
|
|
|
5557 c == LEADING_BYTE_CONTROL_1)
|
|
|
5558 ch = c;
|
|
|
5559 else
|
|
|
5560 Dynarr_add (dst, '~'); /* untranslatable character */
|
|
|
5561 }
|
|
|
5562 else
|
|
|
5563 {
|
|
|
5564 if (ch == LEADING_BYTE_LATIN_ISO8859_1)
|
|
|
5565 Dynarr_add (dst, c);
|
|
|
5566 else if (ch == LEADING_BYTE_CONTROL_1)
|
|
|
5567 {
|
|
|
5568 assert (c < 0xC0);
|
|
|
5569 Dynarr_add (dst, c - 0x20);
|
|
|
5570 }
|
|
|
5571 /* else it should be the second or third byte of an
|
|
|
5572 untranslatable character, so ignore it */
|
|
|
5573 ch = 0;
|
|
|
5574 }
|
|
|
5575 }
|
|
|
5576
|
|
|
5577 str->flags = flags;
|
|
|
5578 str->ch = ch;
|
|
|
5579 }
|
|
|
5580
|
|
|
5581
|
|
440
|
5582
|
|
428
|
5583 /************************************************************************/
|
|
|
5584 /* Initialization */
|
|
|
5585 /************************************************************************/
|
|
|
5586
|
|
|
5587 void
|
|
|
5588 syms_of_file_coding (void)
|
|
|
5589 {
|
|
442
|
5590 INIT_LRECORD_IMPLEMENTATION (coding_system);
|
|
|
5591
|
|
563
|
5592 DEFERROR_STANDARD (Qtext_conversion_error, Qconversion_error);
|
|
428
|
5593
|
|
|
5594 DEFSUBR (Fcoding_system_p);
|
|
|
5595 DEFSUBR (Ffind_coding_system);
|
|
|
5596 DEFSUBR (Fget_coding_system);
|
|
|
5597 DEFSUBR (Fcoding_system_list);
|
|
|
5598 DEFSUBR (Fcoding_system_name);
|
|
|
5599 DEFSUBR (Fmake_coding_system);
|
|
|
5600 DEFSUBR (Fcopy_coding_system);
|
|
440
|
5601 DEFSUBR (Fcoding_system_canonical_name_p);
|
|
|
5602 DEFSUBR (Fcoding_system_alias_p);
|
|
|
5603 DEFSUBR (Fcoding_system_aliasee);
|
|
428
|
5604 DEFSUBR (Fdefine_coding_system_alias);
|
|
|
5605 DEFSUBR (Fsubsidiary_coding_system);
|
|
|
5606
|
|
|
5607 DEFSUBR (Fcoding_system_type);
|
|
|
5608 DEFSUBR (Fcoding_system_doc_string);
|
|
|
5609 DEFSUBR (Fcoding_system_property);
|
|
|
5610
|
|
|
5611 DEFSUBR (Fcoding_category_list);
|
|
|
5612 DEFSUBR (Fset_coding_priority_list);
|
|
|
5613 DEFSUBR (Fcoding_priority_list);
|
|
|
5614 DEFSUBR (Fset_coding_category_system);
|
|
|
5615 DEFSUBR (Fcoding_category_system);
|
|
|
5616
|
|
|
5617 DEFSUBR (Fdetect_coding_region);
|
|
|
5618 DEFSUBR (Fdecode_coding_region);
|
|
|
5619 DEFSUBR (Fencode_coding_region);
|
|
|
5620 #ifdef MULE
|
|
|
5621 DEFSUBR (Fdecode_shift_jis_char);
|
|
|
5622 DEFSUBR (Fencode_shift_jis_char);
|
|
|
5623 DEFSUBR (Fdecode_big5_char);
|
|
|
5624 DEFSUBR (Fencode_big5_char);
|
|
|
5625 DEFSUBR (Fset_ucs_char);
|
|
|
5626 DEFSUBR (Fucs_char);
|
|
|
5627 DEFSUBR (Fset_char_ucs);
|
|
|
5628 DEFSUBR (Fchar_ucs);
|
|
|
5629 #endif /* MULE */
|
|
563
|
5630 DEFSYMBOL_MULTIWORD_PREDICATE (Qcoding_systemp);
|
|
|
5631 DEFSYMBOL (Qno_conversion);
|
|
|
5632 DEFSYMBOL (Qraw_text);
|
|
428
|
5633 #ifdef MULE
|
|
563
|
5634 DEFSYMBOL (Qbig5);
|
|
|
5635 DEFSYMBOL (Qshift_jis);
|
|
428
|
5636 defsymbol (&Qucs4, "ucs-4");
|
|
|
5637 defsymbol (&Qutf8, "utf-8");
|
|
563
|
5638 DEFSYMBOL (Qccl);
|
|
|
5639 DEFSYMBOL (Qiso2022);
|
|
428
|
5640 #endif /* MULE */
|
|
563
|
5641 DEFSYMBOL (Qmnemonic);
|
|
|
5642 DEFSYMBOL (Qeol_type);
|
|
|
5643 DEFSYMBOL (Qpost_read_conversion);
|
|
|
5644 DEFSYMBOL (Qpre_write_conversion);
|
|
|
5645
|
|
|
5646 DEFSYMBOL (Qcr);
|
|
|
5647 DEFSYMBOL (Qlf);
|
|
|
5648 DEFSYMBOL (Qcrlf);
|
|
|
5649 DEFSYMBOL (Qeol_cr);
|
|
|
5650 DEFSYMBOL (Qeol_lf);
|
|
|
5651 DEFSYMBOL (Qeol_crlf);
|
|
428
|
5652 #ifdef MULE
|
|
563
|
5653 DEFSYMBOL (Qcharset_g0);
|
|
|
5654 DEFSYMBOL (Qcharset_g1);
|
|
|
5655 DEFSYMBOL (Qcharset_g2);
|
|
|
5656 DEFSYMBOL (Qcharset_g3);
|
|
|
5657 DEFSYMBOL (Qforce_g0_on_output);
|
|
|
5658 DEFSYMBOL (Qforce_g1_on_output);
|
|
|
5659 DEFSYMBOL (Qforce_g2_on_output);
|
|
|
5660 DEFSYMBOL (Qforce_g3_on_output);
|
|
|
5661 DEFSYMBOL (Qno_iso6429);
|
|
|
5662 DEFSYMBOL (Qinput_charset_conversion);
|
|
|
5663 DEFSYMBOL (Qoutput_charset_conversion);
|
|
|
5664
|
|
|
5665 DEFSYMBOL (Qshort);
|
|
|
5666 DEFSYMBOL (Qno_ascii_eol);
|
|
|
5667 DEFSYMBOL (Qno_ascii_cntl);
|
|
|
5668 DEFSYMBOL (Qseven);
|
|
|
5669 DEFSYMBOL (Qlock_shift);
|
|
|
5670 DEFSYMBOL (Qescape_quoted);
|
|
428
|
5671 #endif /* MULE */
|
|
563
|
5672 DEFSYMBOL (Qencode);
|
|
|
5673 DEFSYMBOL (Qdecode);
|
|
428
|
5674
|
|
|
5675 #ifdef MULE
|
|
|
5676 defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS],
|
|
|
5677 "shift-jis");
|
|
|
5678 defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5],
|
|
|
5679 "big5");
|
|
|
5680 defsymbol (&coding_category_symbol[CODING_CATEGORY_UCS4],
|
|
|
5681 "ucs-4");
|
|
|
5682 defsymbol (&coding_category_symbol[CODING_CATEGORY_UTF8],
|
|
|
5683 "utf-8");
|
|
|
5684 defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7],
|
|
|
5685 "iso-7");
|
|
|
5686 defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE],
|
|
|
5687 "iso-8-designate");
|
|
|
5688 defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1],
|
|
|
5689 "iso-8-1");
|
|
|
5690 defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2],
|
|
|
5691 "iso-8-2");
|
|
|
5692 defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT],
|
|
|
5693 "iso-lock-shift");
|
|
|
5694 #endif /* MULE */
|
|
|
5695 defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION],
|
|
|
5696 "no-conversion");
|
|
|
5697 }
|
|
|
5698
|
|
|
5699 void
|
|
|
5700 lstream_type_create_file_coding (void)
|
|
|
5701 {
|
|
|
5702 LSTREAM_HAS_METHOD (decoding, reader);
|
|
|
5703 LSTREAM_HAS_METHOD (decoding, writer);
|
|
|
5704 LSTREAM_HAS_METHOD (decoding, rewinder);
|
|
|
5705 LSTREAM_HAS_METHOD (decoding, seekable_p);
|
|
|
5706 LSTREAM_HAS_METHOD (decoding, flusher);
|
|
|
5707 LSTREAM_HAS_METHOD (decoding, closer);
|
|
|
5708 LSTREAM_HAS_METHOD (decoding, marker);
|
|
|
5709
|
|
|
5710 LSTREAM_HAS_METHOD (encoding, reader);
|
|
|
5711 LSTREAM_HAS_METHOD (encoding, writer);
|
|
|
5712 LSTREAM_HAS_METHOD (encoding, rewinder);
|
|
|
5713 LSTREAM_HAS_METHOD (encoding, seekable_p);
|
|
|
5714 LSTREAM_HAS_METHOD (encoding, flusher);
|
|
|
5715 LSTREAM_HAS_METHOD (encoding, closer);
|
|
|
5716 LSTREAM_HAS_METHOD (encoding, marker);
|
|
|
5717 }
|
|
|
5718
|
|
|
5719 void
|
|
|
5720 vars_of_file_coding (void)
|
|
|
5721 {
|
|
|
5722 int i;
|
|
|
5723
|
|
|
5724 fcd = xnew (struct file_coding_dump);
|
|
452
|
5725 dump_add_root_struct_ptr (&fcd, &fcd_description);
|
|
428
|
5726
|
|
|
5727 /* Initialize to something reasonable ... */
|
|
448
|
5728 for (i = 0; i < CODING_CATEGORY_LAST; i++)
|
|
428
|
5729 {
|
|
|
5730 fcd->coding_category_system[i] = Qnil;
|
|
|
5731 fcd->coding_category_by_priority[i] = i;
|
|
|
5732 }
|
|
|
5733
|
|
|
5734 Fprovide (intern ("file-coding"));
|
|
|
5735
|
|
|
5736 DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /*
|
|
|
5737 Coding system used for TTY keyboard input.
|
|
|
5738 Not used under a windowing system.
|
|
|
5739 */ );
|
|
|
5740 Vkeyboard_coding_system = Qnil;
|
|
|
5741
|
|
|
5742 DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /*
|
|
|
5743 Coding system used for TTY display output.
|
|
|
5744 Not used under a windowing system.
|
|
|
5745 */ );
|
|
|
5746 Vterminal_coding_system = Qnil;
|
|
|
5747
|
|
|
5748 DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /*
|
|
440
|
5749 Overriding coding system used when reading from a file or process.
|
|
|
5750 You should bind this variable with `let', but do not set it globally.
|
|
|
5751 If this is non-nil, it specifies the coding system that will be used
|
|
|
5752 to decode input on read operations, such as from a file or process.
|
|
|
5753 It overrides `buffer-file-coding-system-for-read',
|
|
428
|
5754 `insert-file-contents-pre-hook', etc. Use those variables instead of
|
|
440
|
5755 this one for permanent changes to the environment. */ );
|
|
428
|
5756 Vcoding_system_for_read = Qnil;
|
|
|
5757
|
|
|
5758 DEFVAR_LISP ("coding-system-for-write",
|
|
|
5759 &Vcoding_system_for_write /*
|
|
440
|
5760 Overriding coding system used when writing to a file or process.
|
|
|
5761 You should bind this variable with `let', but do not set it globally.
|
|
|
5762 If this is non-nil, it specifies the coding system that will be used
|
|
|
5763 to encode output for write operations, such as to a file or process.
|
|
|
5764 It overrides `buffer-file-coding-system', `write-region-pre-hook', etc.
|
|
|
5765 Use those variables instead of this one for permanent changes to the
|
|
|
5766 environment. */ );
|
|
428
|
5767 Vcoding_system_for_write = Qnil;
|
|
|
5768
|
|
|
5769 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /*
|
|
|
5770 Coding system used to convert pathnames when accessing files.
|
|
|
5771 */ );
|
|
|
5772 Vfile_name_coding_system = Qnil;
|
|
|
5773
|
|
|
5774 DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /*
|
|
|
5775 Non-nil means the buffer contents are regarded as multi-byte form
|
|
|
5776 of characters, not a binary code. This affects the display, file I/O,
|
|
|
5777 and behaviors of various editing commands.
|
|
|
5778
|
|
|
5779 Setting this to nil does not do anything.
|
|
|
5780 */ );
|
|
|
5781 enable_multibyte_characters = 1;
|
|
|
5782 }
|
|
|
5783
|
|
|
5784 void
|
|
|
5785 complex_vars_of_file_coding (void)
|
|
|
5786 {
|
|
|
5787 staticpro (&Vcoding_system_hash_table);
|
|
|
5788 Vcoding_system_hash_table =
|
|
|
5789 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
|
|
|
5790
|
|
|
5791 the_codesys_prop_dynarr = Dynarr_new (codesys_prop);
|
|
452
|
5792 dump_add_root_struct_ptr (&the_codesys_prop_dynarr, &codesys_prop_dynarr_description);
|
|
428
|
5793
|
|
|
5794 #define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \
|
|
|
5795 { \
|
|
|
5796 struct codesys_prop csp; \
|
|
|
5797 csp.sym = (Sym); \
|
|
|
5798 csp.prop_type = (Prop_Type); \
|
|
|
5799 Dynarr_add (the_codesys_prop_dynarr, csp); \
|
|
|
5800 } while (0)
|
|
|
5801
|
|
|
5802 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qmnemonic);
|
|
|
5803 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_type);
|
|
|
5804 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_cr);
|
|
|
5805 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_crlf);
|
|
|
5806 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_lf);
|
|
|
5807 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpost_read_conversion);
|
|
|
5808 DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpre_write_conversion);
|
|
|
5809 #ifdef MULE
|
|
|
5810 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0);
|
|
|
5811 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1);
|
|
|
5812 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2);
|
|
|
5813 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3);
|
|
|
5814 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output);
|
|
|
5815 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output);
|
|
|
5816 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output);
|
|
|
5817 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output);
|
|
|
5818 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort);
|
|
|
5819 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol);
|
|
|
5820 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl);
|
|
|
5821 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven);
|
|
|
5822 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift);
|
|
|
5823 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429);
|
|
|
5824 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted);
|
|
|
5825 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion);
|
|
|
5826 DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion);
|
|
|
5827
|
|
|
5828 DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qencode);
|
|
|
5829 DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qdecode);
|
|
|
5830 #endif /* MULE */
|
|
|
5831 /* Need to create this here or we're really screwed. */
|
|
|
5832 Fmake_coding_system
|
|
|
5833 (Qraw_text, Qno_conversion,
|
|
|
5834 build_string ("Raw text, which means it converts only line-break-codes."),
|
|
|
5835 list2 (Qmnemonic, build_string ("Raw")));
|
|
|
5836
|
|
|
5837 Fmake_coding_system
|
|
|
5838 (Qbinary, Qno_conversion,
|
|
|
5839 build_string ("Binary, which means it does not convert anything."),
|
|
|
5840 list4 (Qeol_type, Qlf,
|
|
|
5841 Qmnemonic, build_string ("Binary")));
|
|
|
5842
|
|
|
5843 Fdefine_coding_system_alias (Qno_conversion, Qraw_text);
|
|
|
5844
|
|
440
|
5845 Fdefine_coding_system_alias (Qfile_name, Qbinary);
|
|
|
5846
|
|
|
5847 Fdefine_coding_system_alias (Qterminal, Qbinary);
|
|
|
5848 Fdefine_coding_system_alias (Qkeyboard, Qbinary);
|
|
|
5849
|
|
428
|
5850 /* Need this for bootstrapping */
|
|
|
5851 fcd->coding_category_system[CODING_CATEGORY_NO_CONVERSION] =
|
|
|
5852 Fget_coding_system (Qraw_text);
|
|
|
5853
|
|
|
5854 #ifdef MULE
|
|
|
5855 {
|
|
442
|
5856 size_t i;
|
|
|
5857
|
|
|
5858 for (i = 0; i < countof (fcd->ucs_to_mule_table); i++)
|
|
428
|
5859 fcd->ucs_to_mule_table[i] = Qnil;
|
|
|
5860 }
|
|
|
5861 staticpro (&mule_to_ucs_table);
|
|
|
5862 mule_to_ucs_table = Fmake_char_table(Qgeneric);
|
|
|
5863 #endif /* MULE */
|
|
|
5864 }
|
