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