]> code.delx.au - gnu-emacs/blob - lisp/international/codepage.el
Comment added for a new coding system
[gnu-emacs] / lisp / international / codepage.el
1 ;;; codepage.el --- MS-DOS specific coding systems.
2
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
4
5 ;; Author: Eli Zaretskii
6 ;; Maintainer: FSF
7 ;; Keywords: i18n ms-dos codepage
8
9 ;; This file is part of GNU Emacs.
10
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)
14 ;; any later version.
15
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.
20
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.
25
26 ;;; Commentary:
27
28 ;; Special coding systems for DOS codepage support.
29 ;;
30 ;; These coding systems perform conversion from the DOS codepage encoding
31 ;; to one of the ISO-8859 character sets. Each codepage has its corresponding
32 ;; ISO-8859 charset, chosen so as to be able to convert all (or most) of the
33 ;; characters. The idea is that Emacs internally works with the usual MULE
34 ;; charsets, and the conversion to and from the DOS codepage is performed
35 ;; on I/O only.
36 ;; See term/internal.el for the complementary setup of the DOS terminal
37 ;; display and input methods.
38 ;;
39 ;; Thanks to Ken'ichi Handa <handa@etl.go.jp> for writing the CCL
40 ;; encoders/decoders, and for help in debugging this code.
41
42 ;;; Code:
43
44 (defun cp-coding-system-for-codepage-1 (coding mnemonic iso-name
45 decoder encoder)
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
49 codepage.
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.
54
55 Note that the coding systems created by this function support automatic
56 detection of the EOL format. However, the decoders and encoders created
57 for these coding systems only support DOS and Unix style EOLs (the -mac
58 variety is actually just an alias for the -unix variety)."
59 (save-match-data
60 (let* ((coding-name (symbol-name coding))
61 (undef (if (eq system-type 'ms-dos)
62 (if dos-unsupported-char-glyph
63 (logand dos-unsupported-char-glyph 255)
64 127)
65 ??))
66 (ccl-decoder-dos
67 (ccl-compile
68 `(4 (loop (read r1)
69 (if (r1 != ?\r)
70 (if (r1 >= 128)
71 ((r0 = ,(charset-id 'ascii))
72 (translate-character ,decoder r0 r1)
73 (if (r0 == ,(charset-id 'ascii))
74 (write r1)
75 (write-multibyte-character r0 r1)))
76 (write r1)))
77 (repeat)))))
78 (ccl-decoder-unix
79 (ccl-compile
80 `(4 (loop (read r1)
81 (if (r1 >= 128)
82 ((r0 = ,(charset-id 'ascii))
83 (translate-character ,decoder r0 r1)
84 (if (r0 == ,(charset-id 'ascii))
85 (write r1)
86 (write-multibyte-character r0 r1)))
87 (write r1))
88 (repeat)))))
89 (ccl-encoder-dos
90 (ccl-compile
91 `(1 (loop (read-multibyte-character r0 r1)
92 (if (r1 == ?\n)
93 (write ?\r)
94 (if (r0 != ,(charset-id 'ascii))
95 ((translate-character ,encoder r0 r1)
96 (if (r0 == ,(charset-id 'japanese-jisx0208))
97 ((r1 = ,undef)
98 (write r1))))))
99 (write-repeat r1)))))
100 (ccl-encoder-unix
101 (ccl-compile
102 `(1 (loop (read-multibyte-character r0 r1)
103 (if (r0 != ,(charset-id 'ascii))
104 ((translate-character ,encoder r0 r1)
105 (if (r0 == ,(charset-id 'japanese-jisx0208))
106 ((r1 = ,undef)
107 (write r1)))))
108 (write-repeat r1))))))
109 (if (memq coding coding-system-list)
110 (setq coding-system-list (delq coding coding-system-list)))
111
112 ;; Make coding system CODING.
113 (make-coding-system
114 coding 4 mnemonic
115 (concat "8-bit encoding of " (symbol-name iso-name)
116 " characters using IBM codepage " coding-name)
117 (cons ccl-decoder-unix ccl-encoder-unix)
118 `((safe-charsets ascii ,iso-name)
119 (valid-codes (0 . 255))))
120 ;;; Make coding systems CODING-unix, CODING-dos, CODING-mac.
121 (make-subsidiary-coding-system coding)
122 (put coding 'eol-type (vector (intern (format "%s-unix" coding))
123 (intern (format "%s-dos" coding))
124 (intern (format "%s-mac" coding))))
125 ;; Change CCL code for CODING-dos.
126 (let ((coding-spec (copy-sequence (get coding 'coding-system))))
127 (aset coding-spec 4
128 (cons (check-ccl-program
129 ccl-decoder-dos
130 (intern (format "%s-dos-decoder" coding)))
131 (check-ccl-program
132 ccl-encoder-dos
133 (intern (format "%s-dos-encoder" coding)))))
134 (put (intern (concat coding-name "-dos")) 'coding-system
135 coding-spec)))))
136
137 (defun cp-decoding-vector-for-codepage (table charset offset)
138 "Create a vector for decoding IBM PC characters using conversion table
139 TABLE into an ISO-8859 character set CHARSET whose first non-ASCII
140 character is generated by (make-char CHARSET OFFSET)."
141 (let* ((len (length table))
142 (undefined-char
143 (if (eq system-type 'ms-dos)
144 (if dos-unsupported-char-glyph
145 (logand dos-unsupported-char-glyph 255)
146 127)
147 32))
148 (vec1 (make-vector 256 undefined-char))
149 (i 0))
150 (while (< i offset)
151 (aset vec1 i i)
152 (setq i (1+ i)))
153 (setq i 0)
154 (while (< i len)
155 (if (aref table i)
156 (aset vec1 (aref table i) (make-char charset (+ i offset))))
157 (setq i (1+ i)))
158 vec1))
159
160 ;;; You don't think I created all these tables below by hand, do you?
161 ;;; The following Awk script will create the table for cp850-to-Latin-1
162 ;;; conversion from the RFC 1345 file (the other tables are left as an
163 ;;; excercise):
164 ;;; BEGIN { n_pages = 11;
165 ;;; pn["IBM437"] = 0; pn["IBM850"] = 1; pn["IBM851"] = 2;
166 ;;; pn["IBM852"] = 3; pn["IBM855"] = 4; pn["IBM860"] = 5;
167 ;;; pn["IBM861"] = 6; pn["IBM862"] = 7; pn["IBM863"] = 8;
168 ;;; pn["IBM864"] = 9; pn["IBM865"] = 10;
169 ;;; }
170 ;;; $1 == "&charset" { charset = $2; }
171 ;;; $1 == "&code" { code = $2; }
172 ;;; /^ [^&]/ {
173 ;;; if ((charset ~ /^IBM(437|8(5[0125]|6[0-5]))$/) || (charset ~ /^ISO_8859-1/))
174 ;;; {
175 ;;; for (i = 1; i <= NF; i++)
176 ;;; chars[charset,code++] = $i;
177 ;;; }
178 ;;; }
179 ;;;
180 ;;; END {
181 ;;; for (i = 160; i < 256; i++)
182 ;;; {
183 ;;; c = chars["ISO_8859-1:1987",i];
184 ;;; if (c == "??") # skip unused positions
185 ;;; {
186 ;;; printf " nil";
187 ;;; if ((i - 159)%16 == 0)
188 ;;; printf "\n";
189 ;;; continue;
190 ;;; }
191 ;;; found = 0;
192 ;;; for (j in pn)
193 ;;; map[j] = "nil";
194 ;;; for (combined in chars)
195 ;;; {
196 ;;; candidate = chars[combined];
197 ;;; split (combined, separate, SUBSEP);
198 ;;; if (separate[1] == "IBM850" && candidate == c)
199 ;;; {
200 ;;; found = 1;
201 ;;; map[separate[1]] = separate[2];
202 ;;; }
203 ;;; }
204 ;;; printf " %s", map["IBM850"];
205 ;;; if ((i - 159)%16 == 0)
206 ;;; printf "\n";
207 ;;; }
208 ;;; }
209
210 ;;; WARNING WARNING WARNING!!!
211 ;;;
212 ;;; If you want to get fancy with these tables, remember that the inverse
213 ;;; tables, created by `cp-decoding-vector-for-codepage' above, are installed
214 ;;; on MS-DOS as nonascii-translation-table (see `dos-codepage-setup' on
215 ;;; internal.el). Therefore, you should NOT put any codes below 128 in
216 ;;; these tables! Otherwise, various Emacs commands and functions will
217 ;;; mysteriously fail! For example, a typical screwup is to map the Latin-N
218 ;;; acute accent character to the apostrophe, and have all regexps which
219 ;;; end with "\\'" begin to fail (e.g., the automatic setting of the major
220 ;;; mode by file name extension will stop working).
221 ;;;
222 ;;; You HAVE BEEN warned!
223
224 ;; US/English/PC-8/IBM-2. This doesn't support Latin-1 characters very
225 ;; well, but why not use what we can salvage?
226 (defvar cp437-decode-table
227 ;; Nth element is the code of a cp437 glyph for the multibyte
228 ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
229 ;; The element nil means there's no corresponding cp437 glyph.
230 [
231 255 173 155 156 nil 157 179 nil nil nil 166 174 170 196 nil nil
232 248 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
233 nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
234 nil 165 nil nil nil nil 153 nil nil nil nil nil 154 nil nil 225
235 133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
236 nil 164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 152]
237 "Table for converting ISO-8859-1 characters into codepage 437 glyphs.")
238 (setplist 'cp437-decode-table
239 '(charset latin-iso8859-1 language "Latin-1" offset 160))
240
241 ;; Multilingual (Latin-1)
242 (defvar cp850-decode-table
243 ;; Nth element is the code of a cp850 glyph for the multibyte
244 ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
245 ;; The element nil means there's no corresponding cp850 glyph.
246 [
247 255 173 189 156 207 190 221 245 249 184 166 174 170 240 169 nil
248 248 241 253 252 239 230 244 250 247 251 167 175 172 171 243 168
249 183 181 182 199 142 143 146 128 212 144 210 211 222 214 215 216
250 209 165 227 224 226 229 153 158 157 235 233 234 154 237 231 225
251 133 160 131 198 132 134 145 135 138 130 136 137 141 161 140 139
252 208 164 149 162 147 228 148 246 155 151 163 150 129 236 232 152]
253 "Table for converting ISO-8859-1 characters into codepage 850 glyphs.")
254 (setplist 'cp850-decode-table
255 '(charset latin-iso8859-1 language "Latin-1" offset 160))
256
257 ;; Greek
258 (defvar cp851-decode-table
259 [
260 255 nil nil 156 nil nil nil 245 249 nil nil 174 nil 240 nil nil
261 248 241 nil nil 239 nil 134 nil 141 143 144 175 146 171 149 152
262 161 164 165 166 167 168 169 170 172 173 181 182 184 183 189 190
263 198 199 nil 207 208 209 210 211 212 213 nil nil 155 157 158 159
264 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
265 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
266 "Table for converting ISO-8859-7 characters into codepage 851 glyphs.")
267 (setplist 'cp851-decode-table
268 '(charset greek-iso8859-7 language "Greek" offset 160))
269
270 ;; Slavic/Eastern Europe (Latin-2)
271 (defvar cp852-decode-table
272 [
273 255 164 244 157 207 149 151 245 249 230 184 155 141 240 166 189
274 248 165 247 136 239 150 152 243 242 231 173 156 171 241 167 190
275 232 181 182 198 142 145 143 128 172 144 168 211 183 214 215 210
276 209 227 213 224 226 138 153 158 252 222 233 235 154 237 221 225
277 234 160 131 199 132 146 134 135 159 130 169 137 216 161 140 212
278 208 228 229 162 147 139 148 246 253 133 163 251 129 236 238 250]
279 "Table for converting ISO-8859-2 characters into codepage 852 glyphs.")
280 (setplist 'cp852-decode-table
281 '(charset latin-iso8859-2 language "Latin-2" offset 160))
282
283 ;; Russian
284 (defvar cp855-decode-table
285 [
286 255 133 129 131 135 137 139 141 143 145 147 149 151 240 153 155
287 161 163 236 173 167 169 234 244 184 190 199 209 211 213 215 221
288 226 228 230 232 171 182 165 252 246 250 159 242 238 248 157 224
289 160 162 235 172 166 168 233 243 183 189 198 208 210 212 214 216
290 225 227 229 231 170 181 164 251 245 249 158 241 237 247 156 222
291 239 132 128 130 134 136 138 140 142 144 146 148 150 253 152 154]
292 "Table for converting ISO-8859-5 characters into codepage 855 glyphs.")
293 (setplist 'cp855-decode-table
294 '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
295
296 ;; Turkish
297 (defvar cp857-decode-table
298 [
299 255 nil nil 156 207 nil 245 249 152 158 166 nil 240 nil
300 248 nil 253 252 239 nil nil nil nil 141 159 167 nil 171 nil
301 183 181 182 142 nil nil 128 212 144 210 211 222 214 215 216
302 165 227 224 226 nil 153 232 nil 235 233 234 154 nil nil 225
303 133 160 131 132 nil nil 135 138 130 136 137 236 161 140 139
304 164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 250]
305 "Table for converting ISO-8859-3 characters into codepage 857 glyphs.")
306 (setplist 'cp857-decode-table
307 '(charset latin-iso8859-3 language "Latin-3" offset 160))
308
309 ;; Portuguese
310 (defvar cp860-decode-table
311 [
312 255 173 155 156 nil nil 179 nil nil nil 166 174 170 nil nil nil
313 nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
314 145 134 143 142 nil nil nil 128 146 144 137 nil 152 nil 139 nil
315 nil 165 159 169 140 153 nil nil nil 157 150 nil 154 nil nil nil
316 133 160 131 132 nil nil nil 135 138 130 136 nil 141 161 nil nil
317 nil 164 149 162 147 148 nil 246 nil 151 163 nil 129 nil nil nil]
318 "Table for converting ISO-8859-1 characters into codepage 860 glyphs.")
319 (setplist 'cp860-decode-table
320 '(charset latin-iso8859-1 language "Latin-1" offset 160))
321
322 ;; Icelandic
323 (defvar cp861-decode-table
324 [
325 255 173 nil 156 nil nil nil nil nil nil nil 174 170 nil nil nil
326 nil 241 253 nil nil nil nil 249 nil nil nil 175 172 171 nil 168
327 nil 164 nil nil 142 143 146 128 nil 144 nil nil nil 165 nil nil
328 139 nil 159 166 nil nil 153 nil 157 nil 167 nil 154 151 141 nil
329 133 160 131 nil 132 134 145 135 138 130 136 137 nil 161 nil nil
330 140 nil nil 162 147 nil 148 246 155 nil 163 150 129 152 149 nil]
331 "Table for converting ISO-8859-1 characters into codepage 861 glyphs.")
332 (setplist 'cp861-decode-table
333 '(charset latin-iso8859-1 language "Latin-1" offset 160))
334
335 ;; Hebrew
336 (defvar cp862-decode-table
337 ;; Nth element is the code of a cp862 glyph for the multibyte
338 ;; character created by (make-char 'hebrew-iso8859-8 (+ N 160)).
339 ;; The element nil means there's no corresponding cp850 glyph.
340 [
341 255 173 155 156 nil 157 179 nil nil nil nil 174 170 196 nil nil
342 248 241 253 nil nil 230 nil 249 nil nil 246 175 172 171 nil nil
343 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
344 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 205
345 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
346 144 145 146 147 148 149 150 151 152 153 154 nil nil nil nil nil]
347 "Table for converting ISO-8859-8 characters into codepage 862 glyphs.")
348 (setplist 'cp862-decode-table
349 '(charset hebrew-iso8859-8 language "Hebrew" offset 160))
350
351 ;; French Canadian
352 (defvar cp863-decode-table
353 [
354 255 nil 155 156 152 nil 160 143 164 nil nil 174 170 nil nil 167
355 nil 241 253 166 161 nil 134 249 165 nil nil 175 172 171 173 nil
356 142 nil 132 nil nil nil nil 128 145 144 146 148 nil nil 168 149
357 nil nil nil nil 153 nil nil nil nil 157 nil 158 154 nil nil nil
358 133 nil 131 nil nil nil nil 135 138 130 136 137 141 nil 140 139
359 nil nil nil 162 147 nil nil 246 nil 151 163 150 129 nil nil nil]
360 "Table for converting ISO-8859-1 characters into codepage 863 glyphs.")
361 (setplist 'cp863-decode-table
362 '(charset latin-iso8859-1 language "Latin-1" offset 160))
363
364 ;; Arabic
365 ;; FIXME: Emacs doesn't seem to support the "Arabic" language
366 ;; environment yet. So this is only partially usable, for now
367 (defvar cp864-decode-table
368 [
369 255 nil nil nil 164 nil nil nil nil nil nil nil 172 161 nil nil
370 nil nil nil nil nil nil nil nil nil nil nil 187 nil nil nil 191
371 nil 193 194 195 196 nil 198 199 169 201 170 171 173 174 175 207
372 208 209 210 188 189 190 235 215 216 223 238 nil nil nil nil nil
373 224 247 248 252 251 239 242 243 232 233 253 nil nil nil nil nil
374 nil 241 nil nil nil nil nil nil nil nil nil nil nil nil nil nil]
375 "Table for converting ISO-8859-1 characters into codepage 863 glyphs.")
376 (setplist 'cp864-decode-table
377 '(charset arabic-iso8859-6 language nil offset 160))
378
379 ;; Nordic (Norwegian/Danish)
380 (defvar cp865-decode-table
381 [
382 255 173 nil 156 nil nil nil nil nil nil 166 174 170 nil nil nil
383 nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
384 nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
385 nil 165 nil nil nil nil 153 nil 157 nil nil nil 154 nil nil nil
386 133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
387 nil 164 149 162 147 nil 148 246 155 151 163 150 129 nil nil 152]
388 "Table for converting ISO-8859-1 characters into codepage 865 glyphs.")
389 (setplist 'cp865-decode-table
390 '(charset latin-iso8859-1 language "Latin-1" offset 160))
391
392 ;; Greek (yes, another one!)
393 (defvar cp869-decode-table
394 [
395 255 139 140 156 nil nil 138 245 249 151 nil 174 137 240 nil 142
396 248 241 153 154 239 247 134 136 141 143 144 175 146 171 149 152
397 161 164 165 166 167 168 169 170 172 173 181 182 183 184 189 190
398 198 199 nil 207 208 209 210 211 212 213 145 150 155 157 158 159
399 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
400 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
401 "Table for converting ISO-8859-7 characters into codepage 869 glyphs.")
402 (setplist 'cp869-decode-table
403 '(charset greek-iso8859-7 language "Greek" offset 160))
404
405 ;; Conversion from codepage 775 to Latin-4 for Baltic countries.
406 (defvar cp775-decode-table
407 [
408 255 181 nil 138 150 nil 234 245 166 190 237 149 173 240 207 nil
409 248 208 nil 139 239 nil 235 nil nil 213 137 133 nil nil 216 nil
410 160 nil nil nil 142 143 146 189 182 144 183 nil 184 nil nil 161
411 nil 238 226 232 nil 229 153 158 157 198 nil nil 154 nil 199 225
412 131 nil nil nil 132 134 145 212 209 130 210 nil 211 nil nil 140
413 nil 236 147 233 nil 228 148 nil 155 214 nil nil 129 nil 215 nil]
414 "Table for converting ISO-8859-4 characters into codepage 775 glyphs.")
415 (setplist 'cp775-decode-table
416 '(charset latin-iso8859-4 language "Latin-4" offset 160))
417
418 ;;;###autoload
419 (defun cp-make-coding-systems-for-codepage (codepage iso-name offset)
420 "Create a coding system to convert IBM CODEPAGE into charset ISO-NAME
421 whose first character is at offset OFFSET from the beginning of 8-bit
422 ASCII table.
423
424 The created coding system has the usual 3 subsidiary systems: for Unix-,
425 DOS- and Mac-style EOL conversion. However, unlike built-in coding
426 systems, the Mac-style EOL conversion is currently not supported by the
427 decoder and encoder created by this function."
428 (let* ((decode-table (intern (format "%s-decode-table" codepage)))
429 (nonascii-table
430 (intern (format "%s-nonascii-translation-table" codepage)))
431 (decode-translation
432 (intern (format "%s-decode-translation-table" codepage)))
433 (encode-translation
434 (intern (format "%s-encode-translation-table" codepage))))
435 (set nonascii-table
436 (make-translation-table-from-vector
437 (cp-decoding-vector-for-codepage
438 (symbol-value decode-table) iso-name offset)))
439 (define-translation-table encode-translation
440 (char-table-extra-slot (symbol-value nonascii-table) 0))
441 ;; For charsets other than ascii and ISO-NAME, set `?' for
442 ;; one-column charsets, and some Japanese character for
443 ;; wide-column charsets. CCL encoder convert that Japanese
444 ;; character to either dos-unsupported-char-glyph or "??".
445 (let ((tbl (char-table-extra-slot (symbol-value nonascii-table) 0))
446 (undef (if (eq system-type 'ms-dos)
447 (if dos-unsupported-char-glyph
448 (logand dos-unsupported-char-glyph 255)
449 127)
450 ??))
451 (charsets (delq 'ascii (delq iso-name
452 (copy-sequence charset-list))))
453 (wide-column-char (make-char 'japanese-jisx0208 32 32)))
454 (while charsets
455 (aset tbl (make-char (car charsets))
456 (if (= (charset-width (car charsets)) 1) undef wide-column-char))
457 (setq charsets (cdr charsets))))
458 (define-translation-table decode-translation
459 (symbol-value nonascii-table))
460 (cp-coding-system-for-codepage-1
461 (intern codepage) ?D iso-name decode-translation encode-translation)
462 ))
463
464 (defun cp-codepage-decoder (codepage)
465 "If CODEPAGE is the name of a supported codepage, return its decode table;
466 otherwise return nil."
467 (let ((cp (if (symbolp codepage) (symbol-name codepage) codepage)))
468 (cond
469 ((stringp cp)
470 (intern-soft (format "%s-decode-table" cp)))
471 (t nil))))
472
473 ;;;###autoload
474 (defun cp-charset-for-codepage (codepage)
475 "Return the charset for which there is a translation table to DOS CODEPAGE.
476 CODEPAGE must be the name of a DOS codepage, a string."
477 (let ((cp-decoder (cp-codepage-decoder codepage)))
478 (if (null cp-decoder)
479 (error "Unsupported codepage %s" codepage)
480 (get cp-decoder 'charset))))
481
482 ;;;###autoload
483 (defun cp-language-for-codepage (codepage)
484 "Return the name of the MULE language environment for CODEPAGE.
485 CODEPAGE must be the name of a DOS codepage, a string."
486 (let ((cp-decoder (cp-codepage-decoder codepage)))
487 (if (null cp-decoder)
488 (error "Unsupported codepage %s" codepage)
489 (get cp-decoder 'language))))
490
491 ;;;###autoload
492 (defun cp-offset-for-codepage (codepage)
493 "Return the offset to be used in setting up coding systems for CODEPAGE.
494 CODEPAGE must be the name of a DOS codepage, a string."
495 (let ((cp-decoder (cp-codepage-decoder codepage)))
496 (if (null cp-decoder)
497 (error "Unsupported codepage %s" codepage)
498 (get cp-decoder 'offset))))
499
500 ;;;###autoload
501 (defun cp-supported-codepages ()
502 "Return an alist of supported codepages.
503
504 Each association in the alist has the form (NNN . CHARSET), where NNN is the
505 codepage number, and CHARSET is the MULE charset which is the closest match
506 for the character set supported by that codepage.
507
508 A codepage NNN is supported if a variable called `cpNNN-decode-table' exists,
509 is a vector, and has a charset property."
510 (save-match-data
511 (let (alist chset sname)
512 (mapatoms
513 (function
514 (lambda (sym)
515 (if (and (boundp sym)
516 (string-match "\\`cp\\([1-9][0-9][0-9]\\)-decode-table\\'"
517 (setq sname (symbol-name sym)))
518 (vectorp (symbol-value sym))
519 (setq chset (get sym 'charset)))
520 (setq alist
521 (cons (cons (match-string 1 sname) chset) alist))))))
522 alist)))
523
524 ;;;###autoload
525 (defun codepage-setup (codepage)
526 "Create a coding system cpCODEPAGE to support the IBM codepage CODEPAGE.
527
528 These coding systems are meant for encoding and decoding 8-bit non-ASCII
529 characters used by the IBM codepages, typically in conjunction with files
530 read/written by MS-DOS software, or for display on the MS-DOS terminal."
531 (interactive
532 (let ((completion-ignore-case t)
533 (candidates (cp-supported-codepages)))
534 (list (completing-read "Setup DOS Codepage: (default 437) " candidates
535 nil t nil nil "437"))))
536 (let ((cp (format "cp%s" codepage)))
537 (cp-make-coding-systems-for-codepage
538 cp (cp-charset-for-codepage cp) (cp-offset-for-codepage cp))))
539
540 (provide 'codepage)
541
542 ;; codepage.el ends here