1 ;;; codepage.el --- MS-DOS/MS-Windows specific coding systems.
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
5 ;; Author: Eli Zaretskii
7 ;; Keywords: i18n ms-dos ms-windows codepage
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; Special coding systems for DOS/Windows codepage support.
30 ;; These coding systems perform conversion from the DOS/Windows
31 ;; codepage encoding to one of the ISO-8859 character sets. Each
32 ;; codepage has its corresponding ISO-8859 charset, chosen so as to be
33 ;; able to convert all (or most) of the characters. The idea is that
34 ;; Emacs internally works with the usual MULE charsets, and the
35 ;; conversion to and from the DOS codepage is performed on I/O only.
36 ;; See term/internal.el for the complementary setup of the DOS
37 ;; terminal display and input methods.
39 ;; Thanks to Ken'ichi Handa <handa@etl.go.jp> for writing the CCL
40 ;; encoders/decoders, and for help in debugging this code.
44 (defun cp-coding-system-for-codepage-1 (coding mnemonic iso-name
46 "Make coding system CODING for a DOS codepage using translation tables.
47 MNEMONIC is a character to be displayed on mode line for the coding system.
48 ISO-NAME is the name of the ISO-8859 charset which corresponds to this
50 DECODER is a translation table for converting characters in the DOS codepage
51 encoding to Emacs multibyte characters.
52 ENCODER is a translation table for encoding Emacs multibyte characters into
53 external DOS codepage codes."
55 (let* ((coding-name (symbol-name coding
))
56 (undef (if (eq system-type
'ms-dos
)
57 (if dos-unsupported-char-glyph
58 (logand dos-unsupported-char-glyph
255)
61 (safe-chars (make-char-table 'safe-chars
))
64 ;; The 4 here supplies the buf_magnification parameter
65 ;; for the CCL program. A multibyte character may take
69 ((r0 = ,(charset-id 'ascii
))
70 (translate-character ,decoder r0 r1
)
71 (write-multibyte-character r0 r1
))
76 ;; The 2 here supplies the buf_magnification parameter for
77 ;; the CCL program. Since the -dos coding system generates
78 ;; \r\n for each \n, a factor of 2 covers even the worst case
79 ;; of empty lines with a single \n.
80 `(2 (loop (read-multibyte-character r0 r1
)
81 (if (r0 != ,(charset-id 'ascii
))
82 ((translate-character ,encoder r0 r1
)
83 (if (r0 == ,(charset-id 'japanese-jisx0208
))
86 (write-repeat r1
))))))
88 ;; Set elements of safe multibyte characters for this codepage
89 ;; to t in the char-table safe-chars.
90 (let ((tbl (get decoder
'translation-table
))
94 (setq ch
(aref tbl i
))
95 (if ch
(aset safe-chars ch t
))
98 ;; Make coding system CODING.
101 (concat "8-bit encoding of " (symbol-name iso-name
)
102 " characters using IBM codepage " coding-name
)
103 (cons ccl-decoder ccl-encoder
)
104 `((safe-charsets ascii eight-bit-control eight-bit-graphic
,iso-name
)
105 (safe-chars .
,safe-chars
)
106 (valid-codes (0 .
255)))))))
108 (defun cp-decoding-vector-for-codepage (table charset offset
)
109 "Create a vector for decoding IBM PC characters using conversion table
110 TABLE into an ISO-8859 character set CHARSET whose first non-ASCII
111 character is generated by (make-char CHARSET OFFSET)."
112 (let* ((len (length table
))
114 (if (eq system-type
'ms-dos
)
115 (if dos-unsupported-char-glyph
116 (logand dos-unsupported-char-glyph
255)
119 (vec1 (make-vector 256 undefined-char
))
127 (aset vec1
(aref table i
) (make-char charset
(+ i offset
))))
131 ;;; You don't think I created all these tables below by hand, do you?
132 ;;; The following Awk script will create the table for cp850-to-Latin-1
133 ;;; conversion from the RFC 1345 file (the other tables are left as an
135 ;;; BEGIN { n_pages = 11;
136 ;;; pn["IBM437"] = 0; pn["IBM850"] = 1; pn["IBM851"] = 2;
137 ;;; pn["IBM852"] = 3; pn["IBM855"] = 4; pn["IBM860"] = 5;
138 ;;; pn["IBM861"] = 6; pn["IBM862"] = 7; pn["IBM863"] = 8;
139 ;;; pn["IBM864"] = 9; pn["IBM865"] = 10;
141 ;;; $1 == "&charset" { charset = $2; }
142 ;;; $1 == "&code" { code = $2; }
144 ;;; if ((charset ~ /^IBM(437|8(5[0125]|6[0-5]))$/) || (charset ~ /^ISO_8859-1/))
146 ;;; for (i = 1; i <= NF; i++)
147 ;;; chars[charset,code++] = $i;
152 ;;; for (i = 160; i < 256; i++)
154 ;;; c = chars["ISO_8859-1:1987",i];
155 ;;; if (c == "??") # skip unused positions
158 ;;; if ((i - 159)%16 == 0)
165 ;;; for (combined in chars)
167 ;;; candidate = chars[combined];
168 ;;; split (combined, separate, SUBSEP);
169 ;;; if (separate[1] == "IBM850" && candidate == c)
172 ;;; map[separate[1]] = separate[2];
175 ;;; printf " %s", map["IBM850"];
176 ;;; if ((i - 159)%16 == 0)
181 ;;; WARNING WARNING WARNING!!!
183 ;;; If you want to get fancy with these tables, remember that the inverse
184 ;;; tables, created by `cp-decoding-vector-for-codepage' above, are installed
185 ;;; on MS-DOS as nonascii-translation-table (see `dos-codepage-setup' on
186 ;;; internal.el). Therefore, you should NOT put any codes below 128 in
187 ;;; these tables! Otherwise, various Emacs commands and functions will
188 ;;; mysteriously fail! For example, a typical screwup is to map the Latin-N
189 ;;; acute accent character to the apostrophe, and have all regexps which
190 ;;; end with "\\'" begin to fail (e.g., the automatic setting of the major
191 ;;; mode by file name extension will stop working).
193 ;;; You HAVE BEEN warned!
195 ;; US/English/PC-8/IBM-2. This doesn't support Latin-1 characters very
196 ;; well, but why not use what we can salvage?
197 (defvar cp437-decode-table
198 ;; Nth element is the code of a cp437 glyph for the multibyte
199 ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
200 ;; The element nil means there's no corresponding cp437 glyph.
202 255 173 155 156 nil
157 179 nil nil nil
166 174 170 196 nil nil
203 248 241 253 nil nil nil nil
249 nil nil
167 175 172 171 nil
168
204 nil nil nil nil
142 143 146 128 nil
144 nil nil nil nil nil nil
205 nil
165 nil nil nil nil
153 nil nil nil nil nil
154 nil nil
225
206 133 160 131 nil
132 134 145 135 138 130 136 137 141 161 140 139
207 nil
164 149 162 147 nil
148 246 nil
151 163 150 129 nil nil
152]
208 "Table for converting ISO-8859-1 characters into codepage 437 glyphs.")
209 (setplist 'cp437-decode-table
210 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
212 ;; Multilingual (Latin-1)
213 (defvar cp850-decode-table
214 ;; Nth element is the code of a cp850 glyph for the multibyte
215 ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
216 ;; The element nil means there's no corresponding cp850 glyph.
218 255 173 189 156 207 190 221 245 249 184 166 174 170 240 169 nil
219 248 241 253 252 239 230 244 250 247 251 167 175 172 171 243 168
220 183 181 182 199 142 143 146 128 212 144 210 211 222 214 215 216
221 209 165 227 224 226 229 153 158 157 235 233 234 154 237 231 225
222 133 160 131 198 132 134 145 135 138 130 136 137 141 161 140 139
223 208 164 149 162 147 228 148 246 155 151 163 150 129 236 232 152]
224 "Table for converting ISO-8859-1 characters into codepage 850 glyphs.")
225 (setplist 'cp850-decode-table
226 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
229 (defvar cp851-decode-table
231 255 nil nil
156 nil nil nil
245 249 nil nil
174 nil
240 nil nil
232 248 241 nil nil
239 nil
134 nil
141 143 144 175 146 171 149 152
233 161 164 165 166 167 168 169 170 172 173 181 182 184 183 189 190
234 198 199 nil
207 208 209 210 211 212 213 nil nil
155 157 158 159
235 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
236 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil
]
237 "Table for converting ISO-8859-7 characters into codepage 851 glyphs.")
238 (setplist 'cp851-decode-table
239 '(charset greek-iso8859-7 language
"Greek" offset
160))
241 ;; Slavic/Eastern Europe (Latin-2)
242 (defvar cp852-decode-table
244 255 164 244 157 207 149 151 245 249 230 184 155 141 240 166 189
245 248 165 247 136 239 150 152 243 242 231 173 156 171 241 167 190
246 232 181 182 198 142 145 143 128 172 144 168 211 183 214 215 210
247 209 227 213 224 226 138 153 158 252 222 233 235 154 237 221 225
248 234 160 131 199 132 146 134 135 159 130 169 137 216 161 140 212
249 208 228 229 162 147 139 148 246 253 133 163 251 129 236 238 250]
250 "Table for converting ISO-8859-2 characters into codepage 852 glyphs.")
251 (setplist 'cp852-decode-table
252 '(charset latin-iso8859-2 language
"Latin-2" offset
160))
255 (defvar cp855-decode-table
257 255 133 129 131 135 137 139 141 143 145 147 149 151 240 153 155
258 161 163 236 173 167 169 234 244 184 190 199 209 211 213 215 221
259 226 228 230 232 171 182 165 252 246 250 159 242 238 248 157 224
260 160 162 235 172 166 168 233 243 183 189 198 208 210 212 214 216
261 225 227 229 231 170 181 164 251 245 249 158 241 237 247 156 222
262 239 132 128 130 134 136 138 140 142 144 146 148 150 253 152 154]
263 "Table for converting ISO-8859-5 characters into codepage 855 glyphs.")
264 (setplist 'cp855-decode-table
265 '(charset cyrillic-iso8859-5 language
"Cyrillic-ISO" offset
160))
268 (defvar cp857-decode-table
270 255 nil nil
156 207 nil
245 249 152 158 166 nil
240 nil
271 248 nil
253 252 239 nil nil nil nil
141 159 167 nil
171 nil
272 183 181 182 142 nil nil
128 212 144 210 211 222 214 215 216
273 165 227 224 226 nil
153 232 nil
235 233 234 154 nil nil
225
274 133 160 131 132 nil nil
135 138 130 136 137 236 161 140 139
275 164 149 162 147 nil
148 246 nil
151 163 150 129 nil nil
250]
276 "Table for converting ISO-8859-3 characters into codepage 857 glyphs.")
277 (setplist 'cp857-decode-table
278 '(charset latin-iso8859-3 language
"Latin-3" offset
160))
281 (defvar cp860-decode-table
283 255 173 155 156 nil nil
179 nil nil nil
166 174 170 nil nil nil
284 nil
241 253 nil nil nil nil
249 nil nil
167 175 172 171 nil
168
285 145 134 143 142 nil nil nil
128 146 144 137 nil
152 nil
139 nil
286 nil
165 159 169 140 153 nil nil nil
157 150 nil
154 nil nil nil
287 133 160 131 132 nil nil nil
135 138 130 136 nil
141 161 nil nil
288 nil
164 149 162 147 148 nil
246 nil
151 163 nil
129 nil nil nil
]
289 "Table for converting ISO-8859-1 characters into codepage 860 glyphs.")
290 (setplist 'cp860-decode-table
291 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
294 (defvar cp861-decode-table
296 255 173 nil
156 nil nil nil nil nil nil nil
174 170 nil nil nil
297 nil
241 253 nil nil nil nil
249 nil nil nil
175 172 171 nil
168
298 nil
164 nil nil
142 143 146 128 nil
144 nil nil nil
165 nil nil
299 139 nil
159 166 nil nil
153 nil
157 nil
167 nil
154 151 141 nil
300 133 160 131 nil
132 134 145 135 138 130 136 137 nil
161 nil nil
301 140 nil nil
162 147 nil
148 246 155 nil
163 150 129 152 149 nil
]
302 "Table for converting ISO-8859-1 characters into codepage 861 glyphs.")
303 (setplist 'cp861-decode-table
304 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
307 (defvar cp862-decode-table
308 ;; Nth element is the code of a cp862 glyph for the multibyte
309 ;; character created by (make-char 'hebrew-iso8859-8 (+ N 160)).
310 ;; The element nil means there's no corresponding cp862 glyph.
312 255 173 155 156 nil
157 179 nil nil nil nil
174 170 196 nil nil
313 248 241 253 nil nil
230 nil
249 nil nil
246 175 172 171 nil nil
314 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
315 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
205
316 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
317 144 145 146 147 148 149 150 151 152 153 154 nil nil nil nil nil
]
318 "Table for converting ISO-8859-8 characters into codepage 862 glyphs.")
319 (setplist 'cp862-decode-table
320 '(charset hebrew-iso8859-8 language
"Hebrew" offset
160))
323 (defvar cp863-decode-table
325 255 nil
155 156 152 nil
160 143 164 nil nil
174 170 nil nil
167
326 nil
241 253 166 161 nil
134 249 165 nil nil
175 172 171 173 nil
327 142 nil
132 nil nil nil nil
128 145 144 146 148 nil nil
168 149
328 nil nil nil nil
153 nil nil nil nil
157 nil
158 154 nil nil nil
329 133 nil
131 nil nil nil nil
135 138 130 136 137 141 nil
140 139
330 nil nil nil
162 147 nil nil
246 nil
151 163 150 129 nil nil nil
]
331 "Table for converting ISO-8859-1 characters into codepage 863 glyphs.")
332 (setplist 'cp863-decode-table
333 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
336 ;; FIXME: Emacs doesn't seem to support the "Arabic" language
337 ;; environment yet. So this is only partially usable, for now
338 (defvar cp864-decode-table
340 255 nil nil nil
164 nil nil nil nil nil nil nil
172 161 nil nil
341 nil nil nil nil nil nil nil nil nil nil nil
187 nil nil nil
191
342 nil
193 194 195 196 nil
198 199 169 201 170 171 173 174 175 207
343 208 209 210 188 189 190 235 215 216 223 238 nil nil nil nil nil
344 224 247 248 252 251 239 242 243 232 233 253 nil nil nil nil nil
345 nil
241 nil nil nil nil nil nil nil nil nil nil nil nil nil nil
]
346 "Table for converting ISO-8859-6 characters into codepage 864 glyphs.")
347 (setplist 'cp864-decode-table
348 '(charset arabic-iso8859-6 language nil offset
160))
350 ;; Arabic OEM codepage used by Windows
351 ;; FIXME: Emacs doesn't seem to support the "Arabic" language
352 ;; environment yet. So this is only partially usable, for now
353 (defvar cp720-decode-table
355 255 nil nil nil
148 nil nil nil nil nil nil nil nil
196 nil nil
356 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
357 nil
152 153 154 155 157 158 159 160 161 162 163 164 165 166 167
358 168 169 170 171 172 173 224 225 226 227 228 nil nil nil nil nil
359 149 229 231 232 233 234 235 236 237 238 239 241 242 243 244 245
360 246 145 146 nil nil nil nil nil nil nil nil nil nil nil nil nil
]
361 "Table for converting ISO-8859-6 characters into codepage 720 glyphs.")
362 (setplist 'cp720-decode-table
363 '(charset arabic-iso8859-6 language nil offset
160))
366 ;; Nordic (Norwegian/Danish)
367 (defvar cp865-decode-table
369 255 173 nil
156 nil nil nil nil nil nil
166 174 170 nil nil nil
370 nil
241 253 nil nil nil nil
249 nil nil
167 175 172 171 nil
168
371 nil nil nil nil
142 143 146 128 nil
144 nil nil nil nil nil nil
372 nil
165 nil nil nil nil
153 nil
157 nil nil nil
154 nil nil nil
373 133 160 131 nil
132 134 145 135 138 130 136 137 141 161 140 139
374 nil
164 149 162 147 nil
148 246 155 151 163 150 129 nil nil
152]
375 "Table for converting ISO-8859-1 characters into codepage 865 glyphs.")
376 (setplist 'cp865-decode-table
377 '(charset latin-iso8859-1 language
"Latin-1" offset
160))
379 ;; Russian (Yes, another one! This one's supposed to be used
380 ;; on Windows as the Russian OEM code page.)
381 (defvar cp866-decode-table
383 255 240 nil nil
242 nil nil
244 nil nil nil nil nil nil
246 nil
384 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
385 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
386 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
387 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
388 252 241 nil nil
243 nil nil
245 nil nil nil nil nil nil
247 nil
]
389 "Table for converting ISO-8859-5 characters into codepage 866 glyphs.")
390 (setplist 'cp866-decode-table
391 '(charset cyrillic-iso8859-5 language
"Cyrillic-ISO" offset
160))
393 ;; Greek (yes, another one!)
394 (defvar cp869-decode-table
396 255 139 140 156 nil nil
138 245 249 151 nil
174 137 240 nil
142
397 248 241 153 154 239 247 134 136 141 143 144 175 146 171 149 152
398 161 164 165 166 167 168 169 170 172 173 181 182 183 184 189 190
399 198 199 nil
207 208 209 210 211 212 213 145 150 155 157 158 159
400 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
401 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil
]
402 "Table for converting ISO-8859-7 characters into codepage 869 glyphs.")
403 (setplist 'cp869-decode-table
404 '(charset greek-iso8859-7 language
"Greek" offset
160))
406 ;; Greek OEM codepage used by Windows
407 (defvar cp737-decode-table
409 255 nil nil nil nil nil
179 nil nil nil nil nil nil
196 nil nil
410 248 241 253 nil nil nil
234 250 235 236 237 nil
238 nil
239 240
411 nil
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
412 143 144 nil
145 146 147 148 149 150 151 244 245 225 226 227 229
413 nil
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
414 167 168 170 169 171 172 173 174 175 224 228 232 230 231 233 nil
]
415 "Table for converting ISO-8859-7 characters into codepage 737 glyphs.")
416 (setplist 'cp737-decode-table
417 '(charset greek-iso8859-7 language
"Greek" offset
160))
419 ;; Conversion from codepage 775 to Latin-4 for Baltic countries.
420 (defvar cp775-decode-table
422 255 181 nil
138 150 nil
234 245 166 190 237 149 173 240 207 nil
423 248 208 nil
139 239 nil
235 nil nil
213 137 133 nil nil
216 nil
424 160 nil nil nil
142 143 146 189 182 144 183 nil
184 nil nil
161
425 nil
238 226 232 nil
229 153 158 157 198 nil nil
154 nil
199 225
426 131 nil nil nil
132 134 145 212 209 130 210 nil
211 nil nil
140
427 nil
236 147 233 nil
228 148 nil
155 214 nil nil
129 nil
215 nil
]
428 "Table for converting ISO-8859-4 characters into codepage 775 glyphs.")
429 (setplist 'cp775-decode-table
430 '(charset latin-iso8859-4 language
"Latin-4" offset
160))
432 ;; Support for the Windows 12xx series of codepages that MS has
433 ;; butchered from the ISO-8859 specs. This does not add support for
434 ;; the extended characters that MS has added in the 128 - 159 coding
435 ;; range, only translates those characters that can be expressed in
436 ;; the corresponding iso-8859 charset.
440 ;; Windows-1250: ISO-8859-2 (Central Europe) - differs in some positions
441 ;; Windows-1251: ISO-8859-5 (Cyrillic) - differs wildly
442 ;; Windows-1252: ISO-8859-1 (West Europe) - exact match
443 ;; Windows-1253: ISO-8859-7 (Greek) - differs in some positions
444 ;; Windows-1254: ISO-8859-9 (Turkish) - exact match
445 ;; Windows-1255: ISO-8859-8 (Hebrew) - exact match
446 ;; Windows-1256: ISO-8859-6 (Arabic) - half match
447 ;; Windows-1257: ISO-8859-4 (Baltic) - differs, future Latin-7
448 ;; Windows-1258: VISCII (Vietnamese) - Completely different
450 (defvar cp1250-decode-table
452 160 165 162 163 164 188 140 167 168 138 170 141 143 173 142 175
453 176 185 178 179 180 190 156 161 184 154 186 157 159 189 158 191
454 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
455 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
456 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
457 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 ]
458 "ISO-8859-2 to Windows-1250 (Central Europe) codepage decoding table")
459 (setplist 'cp1250-decode-table
460 '(charset latin-iso8859-2 language
"Latin-2" offset
160))
462 (defvar cp1251-decode-table
464 160 168 128 129 170 189 178 175 163 138 140 142 141 173 161 143
465 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
466 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
467 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
468 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
469 185 184 144 131 186 190 179 191 188 154 156 158 157 167 162 159 ]
470 "ISO-8859-5 to Windows-1251 (Cyrillic) codepage decoding table")
471 (setplist 'cp1251-decode-table
472 '(charset cyrillic-iso8859-5 language
"Cyrillic-ISO" offset
160))
474 ;; cp1253 is missing nbsp so we cannot quite translate perfectly. It
475 ;; also has two micro/mu characters which would require more complex
476 ;; processing to accomodate.
477 (defvar cp1253-decode-table
479 nil
145 146 163 nil nil
166 167 168 169 nil
171 172 173 nil
151
480 176 177 178 179 180 161 162 183 184 185 186 187 188 189 190 191
481 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
482 208 209 nil
211 212 213 214 215 216 217 218 219 220 221 222 223
483 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
484 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 nil
]
485 "ISO-8859-7 to Windows-1253 (Greek) codepage decoding table")
486 (setplist 'cp1253-decode-table
487 '(charset greek-iso8859-7 language
"Greek" offset
160))
489 ;; Since Latin-7 is not yet official, and Emacs does not support it,
490 ;; provide translation between Windows-1257 and Latin-4 the best we
492 (defvar cp1257-decode-table
494 160 192 nil
170 164 nil
207 167 nil
208 199 204 nil
173 222 nil
495 176 224 nil
186 nil nil
239 nil nil
240 231 236 nil nil
254 nil
496 194 nil nil nil
196 197 175 193 200 201 198 nil
203 nil nil
206
497 nil
210 212 205 nil
213 214 215 168 216 nil nil
220 nil
219 223
498 226 nil nil nil
228 229 191 225 232 233 230 nil
235 nil nil
238
499 nil
242 244 237 nil
245 246 247 184 248 nil nil
252 nil
251 nil
]
500 "ISO-8859-4 to Windows-1257 (Baltic) codepage decoding table")
501 (setplist 'cp1257-decode-table
502 '(charset latin-iso8859-4 language
"Latin-4" offset
160))
505 (defun cp-make-coding-systems-for-codepage (codepage iso-name offset
)
506 "Create a coding system to convert IBM CODEPAGE into charset ISO-NAME
507 whose first character is at offset OFFSET from the beginning of 8-bit
510 The created coding system has the usual 3 subsidiary systems: for Unix-,
511 DOS- and Mac-style EOL conversion. However, unlike built-in coding
512 systems, the Mac-style EOL conversion is currently not supported by the
513 decoder and encoder created by this function."
514 (let* ((decode-table (intern (format "%s-decode-table" codepage
)))
516 (intern (format "%s-nonascii-translation-table" codepage
)))
518 (intern (format "%s-decode-translation-table" codepage
)))
520 (intern (format "%s-encode-translation-table" codepage
))))
522 (make-translation-table-from-vector
523 (cp-decoding-vector-for-codepage
524 (symbol-value decode-table
) iso-name offset
)))
525 (define-translation-table encode-translation
526 (char-table-extra-slot (symbol-value nonascii-table
) 0))
527 ;; For charsets other than ascii, eight-bit-* and ISO-NAME, set
528 ;; `?' for one-column charsets, and some Japanese character for
529 ;; wide-column charsets. CCL encoder convert that Japanese
530 ;; character to either dos-unsupported-char-glyph or "??".
531 (let ((tbl (char-table-extra-slot (symbol-value nonascii-table
) 0))
532 (undef (if (eq system-type
'ms-dos
)
533 (if dos-unsupported-char-glyph
534 (logand dos-unsupported-char-glyph
255)
537 (charsets (delq 'ascii
538 (delq 'eight-bit-control
539 (delq 'eight-bit-graphic
541 (copy-sequence charset-list
))))))
542 (wide-column-char (make-char 'japanese-jisx0208
32 32)))
544 (aset tbl
(make-char (car charsets
))
545 (if (= (charset-width (car charsets
)) 1) undef wide-column-char
))
546 (setq charsets
(cdr charsets
))))
547 (define-translation-table decode-translation
548 (symbol-value nonascii-table
))
549 (cp-coding-system-for-codepage-1
550 (intern codepage
) ?D iso-name decode-translation encode-translation
)
553 (defun cp-codepage-decoder (codepage)
554 "If CODEPAGE is the name of a supported codepage, return its decode table;
555 otherwise return nil."
556 (let ((cp (if (symbolp codepage
) (symbol-name codepage
) codepage
)))
559 (intern-soft (format "%s-decode-table" cp
)))
563 (defun cp-charset-for-codepage (codepage)
564 "Return the charset for which there is a translation table to DOS CODEPAGE.
565 CODEPAGE must be the name of a DOS codepage, a string."
566 (let ((cp-decoder (cp-codepage-decoder codepage
)))
567 (if (null cp-decoder
)
568 (error "Unsupported codepage %s" codepage
)
569 (get cp-decoder
'charset
))))
572 (defun cp-language-for-codepage (codepage)
573 "Return the name of the MULE language environment for CODEPAGE.
574 CODEPAGE must be the name of a DOS codepage, a string."
575 (let ((cp-decoder (cp-codepage-decoder codepage
)))
576 (if (null cp-decoder
)
577 (error "Unsupported codepage %s" codepage
)
578 (get cp-decoder
'language
))))
581 (defun cp-offset-for-codepage (codepage)
582 "Return the offset to be used in setting up coding systems for CODEPAGE.
583 CODEPAGE must be the name of a DOS codepage, a string."
584 (let ((cp-decoder (cp-codepage-decoder codepage
)))
585 (if (null cp-decoder
)
586 (error "Unsupported codepage %s" codepage
)
587 (get cp-decoder
'offset
))))
590 (defun cp-supported-codepages ()
591 "Return an alist of supported codepages.
593 Each association in the alist has the form (NNN . CHARSET), where NNN is the
594 codepage number, and CHARSET is the MULE charset which is the closest match
595 for the character set supported by that codepage.
597 A codepage NNN is supported if a variable called `cpNNN-decode-table' exists,
598 is a vector, and has a charset property."
600 (let (alist chset sname
)
604 (if (and (boundp sym
)
605 (string-match "\\`cp\\([1-9][0-9][0-9][0-9]?\\)-decode-table\\'"
606 (setq sname
(symbol-name sym
)))
607 (vectorp (symbol-value sym
))
608 (setq chset
(get sym
'charset
)))
610 (cons (cons (match-string 1 sname
) chset
) alist
))))))
614 (defun codepage-setup (codepage)
615 "Create a coding system cpCODEPAGE to support the IBM codepage CODEPAGE.
617 These coding systems are meant for encoding and decoding 8-bit non-ASCII
618 characters used by the IBM codepages, typically in conjunction with files
619 read/written by MS-DOS software, or for display on the MS-DOS terminal."
621 (let ((completion-ignore-case t
)
622 (candidates (cp-supported-codepages)))
623 (list (completing-read "Setup DOS Codepage: (default 437) " candidates
624 nil t nil nil
"437"))))
625 (let ((cp (format "cp%s" codepage
)))
626 (cp-make-coding-systems-for-codepage
627 cp
(cp-charset-for-codepage cp
) (cp-offset-for-codepage cp
))))
631 ;; codepage.el ends here