lisp/international/codepage.el

   1 ;;; codepage.el --- MS-DOS/MS-Windows specific coding systems
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2002  Free Software Foundation, Inc.
   4 ;; Copyright (C) 2000
   5 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   6 ;;   Registration Number H14PRO021
   7
   8 ;; Author: Eli Zaretskii
   9 ;; Maintainer: FSF
  10 ;; Keywords: i18n ms-dos ms-windows codepage
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; Special coding systems for DOS/Windows codepage support.
  32 ;;
  33 ;; These coding systems perform conversion from the DOS/Windows
  34 ;; codepage encoding to one of the ISO-8859 character sets.  Each
  35 ;; codepage has its corresponding ISO-8859 charset, chosen so as to be
  36 ;; able to convert all (or most) of the characters.  The idea is that
  37 ;; Emacs internally works with the usual MULE charsets, and the
  38 ;; conversion to and from the DOS codepage is performed on I/O only.
  39 ;; See term/internal.el for the complementary setup of the DOS
  40 ;; terminal display and input methods.
  41 ;;
  42 ;; Thanks to Ken'ichi Handa <handa@etl.go.jp> for writing the CCL
  43 ;; encoders/decoders, and for help in debugging this code.
  44
  45 ;;; Code:
  46
  47 (defvar dos-unsupported-char-glyph)
  48
  49 (defun cp-coding-system-for-codepage-1 (coding mnemonic iso-name
  50                                                decoder encoder)
  51   "Make coding system CODING for a DOS codepage using translation tables.
  52 MNEMONIC is a character to be displayed on mode line for the coding system.
  53 ISO-NAME is the name of the ISO-8859 charset which corresponds to this
  54 codepage.
  55 DECODER is a translation table for converting characters in the DOS codepage
  56 encoding to Emacs multibyte characters.
  57 ENCODER is a translation table for encoding Emacs multibyte characters into
  58 external DOS codepage codes."
  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            (safe-chars (make-char-table 'safe-chars))
  67            (ccl-decoder
  68             (ccl-compile
  69              ;; The 4 here supplies the buf_magnification parameter
  70              ;; for the CCL program.  A multibyte character may take
  71              ;; at most 4-bytes.
  72              `(4 (loop (read r1)
  73                        (if (r1 >= 128)
  74                            ((r0 = ,(charset-id 'ascii))
  75                             (translate-character ,decoder r0 r1)
  76                             (write-multibyte-character r0 r1))
  77                          (write r1))
  78                        (repeat)))))
  79            (ccl-encoder
  80             (ccl-compile
  81              ;; The 2 here supplies the buf_magnification parameter for
  82              ;; the CCL program.  Since the -dos coding system generates
  83              ;; \r\n for each \n, a factor of 2 covers even the worst case
  84              ;; of empty lines with a single \n.
  85              `(2 (loop (read-multibyte-character r0 r1)
  86                        (if (r0 != ,(charset-id 'ascii))
  87                            ((translate-character ,encoder r0 r1)
  88                             (if (r0 == ,(charset-id 'japanese-jisx0208))
  89                                 ((r1 = ,undef)
  90                                  (write r1)))))
  91                        (write-repeat r1))))))
  92
  93       ;; Set elements of safe multibyte characters for this codepage
  94       ;; to t in the char-table safe-chars.
  95       (let ((tbl (get decoder 'translation-table))
  96             (i 128)
  97             ch)
  98         (while (< i 256)
  99           (setq ch (aref tbl i))
 100           (if ch (aset safe-chars ch t))
 101           (setq i (1+ i))))
 102
 103       ;; Make coding system CODING.
 104       (make-coding-system
 105        coding 4 mnemonic
 106        (concat "8-bit encoding of " (symbol-name iso-name)
 107                " characters using IBM codepage " coding-name)
 108        (cons ccl-decoder ccl-encoder)
 109        `((safe-charsets ascii eight-bit-control eight-bit-graphic ,iso-name)
 110          (safe-chars . ,safe-chars)
 111          (valid-codes (0 . 255)))))))
 112
 113 (defun cp-decoding-vector-for-codepage (table charset offset)
 114   "Create a vector for decoding IBM PC characters using conversion table
 115 TABLE into an ISO-8859 character set CHARSET whose first non-ASCII
 116 character is generated by (make-char CHARSET OFFSET)."
 117   (let* ((len (length table))
 118          (undefined-char
 119           (if (eq system-type 'ms-dos)
 120               (if dos-unsupported-char-glyph
 121                   (logand dos-unsupported-char-glyph 255)
 122                 127)
 123             32))
 124          (vec1 (make-vector 256 undefined-char))
 125          (i 0))
 126     (while (< i 256)
 127       (aset vec1 i i)
 128       (setq i (1+ i)))
 129     (setq i 0)
 130     (while (< i len)
 131       (if (aref table i)
 132           (aset vec1 (aref table i) (make-char charset (+ i offset))))
 133       (setq i (1+ i)))
 134     vec1))
 135
 136 ;;; You don't think I created all these tables below by hand, do you?
 137 ;;; The following Awk script will create the table for cp850-to-Latin-1
 138 ;;; conversion from the RFC 1345 file (the other tables are left as an
 139 ;;; excercise):
 140 ;;; BEGIN { n_pages = 11;
 141 ;;;         pn["IBM437"] = 0; pn["IBM850"] = 1; pn["IBM851"] = 2;
 142 ;;;         pn["IBM852"] = 3; pn["IBM855"] = 4; pn["IBM860"] = 5;
 143 ;;;         pn["IBM861"] = 6; pn["IBM862"] = 7; pn["IBM863"] = 8;
 144 ;;;         pn["IBM864"] = 9; pn["IBM865"] = 10;
 145 ;;;       }
 146 ;;; $1 == "&charset" { charset = $2; }
 147 ;;; $1 == "&code"    { code = $2; }
 148 ;;; /^  [^&]/  {
 149 ;;;   if ((charset ~ /^IBM(437|8(5[0125]|6[0-5]))$/) || (charset ~ /^ISO_8859-1/))
 150 ;;;     {
 151 ;;;       for (i = 1; i <= NF; i++)
 152 ;;;         chars[charset,code++] = $i;
 153 ;;;     }
 154 ;;;   }
 155 ;;;
 156 ;;; END {
 157 ;;;   for (i = 160; i < 256; i++)
 158 ;;;     {
 159 ;;;       c =  chars["ISO_8859-1:1987",i];
 160 ;;;       if (c == "??")        # skip unused positions
 161 ;;;         {
 162 ;;;           printf " nil";
 163 ;;;           if ((i - 159)%16 == 0)
 164 ;;;             printf "\n";
 165 ;;;           continue;
 166 ;;;         }
 167 ;;;       found = 0;
 168 ;;;       for (j in pn)
 169 ;;;         map[j] = "nil";
 170 ;;;       for (combined in chars)
 171 ;;;         {
 172 ;;;           candidate = chars[combined];
 173 ;;;           split (combined, separate, SUBSEP);
 174 ;;;           if (separate[1] == "IBM850" && candidate == c)
 175 ;;;             {
 176 ;;;               found = 1;
 177 ;;;               map[separate[1]] = separate[2];
 178 ;;;             }
 179 ;;;         }
 180 ;;;       printf " %s", map["IBM850"];
 181 ;;;       if ((i - 159)%16 == 0)
 182 ;;;         printf "\n";
 183 ;;;     }
 184 ;;; }
 185
 186 ;;; WARNING WARNING WARNING!!!
 187 ;;;
 188 ;;; If you want to get fancy with these tables, remember that the inverse
 189 ;;; tables, created by `cp-decoding-vector-for-codepage' above, are installed
 190 ;;; on MS-DOS as nonascii-translation-table (see `dos-codepage-setup' on
 191 ;;; internal.el).  Therefore, you should NOT put any codes below 128 in
 192 ;;; these tables!  Otherwise, various Emacs commands and functions will
 193 ;;; mysteriously fail!  For example, a typical screwup is to map the Latin-N
 194 ;;; acute accent character to the apostrophe, and have all regexps which
 195 ;;; end with "\\'" begin to fail (e.g., the automatic setting of the major
 196 ;;; mode by file name extension will stop working).
 197 ;;;
 198 ;;; You HAVE BEEN warned!
 199
 200 ;; US/English/PC-8/IBM-2.  This doesn't support Latin-1 characters very
 201 ;; well, but why not use what we can salvage?
 202 (defvar cp437-decode-table
 203   ;; Nth element is the code of a cp437 glyph for the multibyte
 204   ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
 205   ;; The element nil means there's no corresponding cp437 glyph.
 206   [
 207    255 173 155 156 nil 157 179 nil nil nil 166 174 170 196 nil nil
 208    248 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
 209    nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
 210    nil 165 nil nil nil nil 153 nil nil nil nil nil 154 nil nil 225
 211    133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
 212    nil 164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 152]
 213   "Table for converting ISO-8859-1 characters into codepage 437 glyphs.")
 214 (setplist 'cp437-decode-table
 215           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 216
 217 ;; Multilingual (Latin-1)
 218 (defvar cp850-decode-table
 219   ;; Nth element is the code of a cp850 glyph for the multibyte
 220   ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
 221   ;; The element nil means there's no corresponding cp850 glyph.
 222   [
 223    255 173 189 156 207 190 221 245 249 184 166 174 170 240 169 nil
 224    248 241 253 252 239 230 244 250 247 251 167 175 172 171 243 168
 225    183 181 182 199 142 143 146 128 212 144 210 211 222 214 215 216
 226    209 165 227 224 226 229 153 158 157 235 233 234 154 237 231 225
 227    133 160 131 198 132 134 145 135 138 130 136 137 141 161 140 139
 228    208 164 149 162 147 228 148 246 155 151 163 150 129 236 232 152]
 229   "Table for converting ISO-8859-1 characters into codepage 850 glyphs.")
 230 (setplist 'cp850-decode-table
 231           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 232
 233 ;; Greek
 234 (defvar cp851-decode-table
 235   [
 236    255 nil nil 156 nil nil nil 245 249 nil nil 174 nil 240 nil nil
 237    248 241 nil nil 239 nil 134 nil 141 143 144 175 146 171 149 152
 238    161 164 165 166 167 168 169 170 172 173 181 182 184 183 189 190
 239    198 199 nil 207 208 209 210 211 212 213 nil nil 155 157 158 159
 240    252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
 241    234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
 242   "Table for converting ISO-8859-7 characters into codepage 851 glyphs.")
 243 (setplist 'cp851-decode-table
 244           '(charset greek-iso8859-7 language "Greek" offset 160))
 245
 246 ;; Slavic/Eastern Europe (Latin-2)
 247 (defvar cp852-decode-table
 248   [
 249    255 164 244 157 207 149 151 245 249 230 184 155 141 240 166 189
 250    248 165 247 136 239 150 152 243 242 231 173 156 171 241 167 190
 251    232 181 182 198 142 145 143 128 172 144 168 211 183 214 215 210
 252    209 227 213 224 226 138 153 158 252 222 233 235 154 237 221 225
 253    234 160 131 199 132 146 134 135 159 130 169 137 216 161 140 212
 254    208 228 229 162 147 139 148 246 253 133 163 251 129 236 238 250]
 255   "Table for converting ISO-8859-2 characters into codepage 852 glyphs.")
 256 (setplist 'cp852-decode-table
 257           '(charset latin-iso8859-2 language "Latin-2" offset 160))
 258
 259 ;; Russian
 260 (defvar cp855-decode-table
 261   [
 262    255 133 129 131 135 137 139 141 143 145 147 149 151 240 153 155
 263    161 163 236 173 167 169 234 244 184 190 199 209 211 213 215 221
 264    226 228 230 232 171 182 165 252 246 250 159 242 238 248 157 224
 265    160 162 235 172 166 168 233 243 183 189 198 208 210 212 214 216
 266    225 227 229 231 170 181 164 251 245 249 158 241 237 247 156 222
 267    239 132 128 130 134 136 138 140 142 144 146 148 150 253 152 154]
 268   "Table for converting ISO-8859-5 characters into codepage 855 glyphs.")
 269 (setplist 'cp855-decode-table
 270           '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
 271
 272 ;; Turkish
 273 (defvar cp857-decode-table
 274   [
 275    255 nil nil 156 207 nil 245 249 152 158 166 nil 240 nil
 276    248 nil 253 252 239 nil nil nil nil 141 159 167 nil 171 nil
 277    183 181 182 142 nil nil 128 212 144 210 211 222 214 215 216
 278    165 227 224 226 nil 153 232 nil 235 233 234 154 nil nil 225
 279    133 160 131 132 nil nil 135 138 130 136 137 236 161 140 139
 280    164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 250]
 281   "Table for converting ISO-8859-3 characters into codepage 857 glyphs.")
 282 (setplist 'cp857-decode-table
 283           '(charset latin-iso8859-3 language "Latin-3" offset 160))
 284
 285 ;; Portuguese
 286 (defvar cp860-decode-table
 287   [
 288    255 173 155 156 nil nil 179 nil nil nil 166 174 170 nil nil nil
 289    nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
 290    145 134 143 142 nil nil nil 128 146 144 137 nil 152 nil 139 nil
 291    nil 165 159 169 140 153 nil nil nil 157 150 nil 154 nil nil nil
 292    133 160 131 132 nil nil nil 135 138 130 136 nil 141 161 nil nil
 293    nil 164 149 162 147 148 nil 246 nil 151 163 nil 129 nil nil nil]
 294   "Table for converting ISO-8859-1 characters into codepage 860 glyphs.")
 295 (setplist 'cp860-decode-table
 296           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 297
 298 ;; Icelandic
 299 (defvar cp861-decode-table
 300   [
 301    255 173 nil 156 nil nil nil nil nil nil nil 174 170 nil nil nil
 302    nil 241 253 nil nil nil nil 249 nil nil nil 175 172 171 nil 168
 303    nil 164 nil nil 142 143 146 128 nil 144 nil nil nil 165 nil nil
 304    139 nil 159 166 nil nil 153 nil 157 nil 167 nil 154 151 141 nil
 305    133 160 131 nil 132 134 145 135 138 130 136 137 nil 161 nil nil
 306    140 nil nil 162 147 nil 148 246 155 nil 163 150 129 152 149 nil]
 307   "Table for converting ISO-8859-1 characters into codepage 861 glyphs.")
 308 (setplist 'cp861-decode-table
 309           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 310
 311 ;; Hebrew
 312 (defvar cp862-decode-table
 313   ;; Nth element is the code of a cp862 glyph for the multibyte
 314   ;; character created by (make-char 'hebrew-iso8859-8 (+ N 160)).
 315   ;; The element nil means there's no corresponding cp862 glyph.
 316   [
 317    255 173 155 156 nil 157 179 nil nil nil nil 174 170 196 nil nil
 318    248 241 253 nil nil 230 nil 249 nil nil 246 175 172 171 nil nil
 319    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 320    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 205
 321    128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
 322    144 145 146 147 148 149 150 151 152 153 154 nil nil nil nil nil]
 323   "Table for converting ISO-8859-8 characters into codepage 862 glyphs.")
 324 (setplist 'cp862-decode-table
 325           '(charset hebrew-iso8859-8 language "Hebrew" offset 160))
 326
 327 ;; French Canadian
 328 (defvar cp863-decode-table
 329   [
 330    255 nil 155 156 152 nil 160 143 164 nil nil 174 170 nil nil 167
 331    nil 241 253 166 161 nil 134 249 165 nil nil 175 172 171 173 nil
 332    142 nil 132 nil nil nil nil 128 145 144 146 148 nil nil 168 149
 333    nil nil nil nil 153 nil nil nil nil 157 nil 158 154 nil nil nil
 334    133 nil 131 nil nil nil nil 135 138 130 136 137 141 nil 140 139
 335    nil nil nil 162 147 nil nil 246 nil 151 163 150 129 nil nil nil]
 336   "Table for converting ISO-8859-1 characters into codepage 863 glyphs.")
 337 (setplist 'cp863-decode-table
 338           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 339
 340 ;; Arabic
 341 ;; FIXME: Emacs doesn't seem to support the "Arabic" language
 342 ;; environment yet.  So this is only partially usable, for now
 343 (defvar cp864-decode-table
 344   [
 345    255 nil nil nil 164 nil nil nil nil nil nil nil 172 161 nil nil
 346    nil nil nil nil nil nil nil nil nil nil nil 187 nil nil nil 191
 347    nil 193 194 195 196 nil 198 199 169 201 170 171 173 174 175 207
 348    208 209 210 188 189 190 235 215 216 223 238 nil nil nil nil nil
 349    224 247 248 252 251 239 242 243 232 233 253 nil nil nil nil nil
 350    nil 241 nil nil nil nil nil nil nil nil nil nil nil nil nil nil]
 351   "Table for converting ISO-8859-6 characters into codepage 864 glyphs.")
 352 (setplist 'cp864-decode-table
 353           '(charset arabic-iso8859-6 language nil offset 160))
 354
 355 ;; Arabic OEM codepage used by Windows
 356 ;; FIXME: Emacs doesn't seem to support the "Arabic" language
 357 ;; environment yet.  So this is only partially usable, for now
 358 (defvar cp720-decode-table
 359   [
 360    255 nil nil nil 148 nil nil nil nil nil nil nil nil 196 nil nil
 361    nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
 362    nil 152 153 154 155 157 158 159 160 161 162 163 164 165 166 167
 363    168 169 170 171 172 173 224 225 226 227 228 nil nil nil nil nil
 364    149 229 231 232 233 234 235 236 237 238 239 241 242 243 244 245
 365    246 145 146 nil nil nil nil nil nil nil nil nil nil nil nil nil]
 366   "Table for converting ISO-8859-6 characters into codepage 720 glyphs.")
 367 (setplist 'cp720-decode-table
 368           '(charset arabic-iso8859-6 language nil offset 160))
 369
 370
 371 ;; Nordic (Norwegian/Danish)
 372 (defvar cp865-decode-table
 373   [
 374    255 173 nil 156 nil nil nil nil nil nil 166 174 170 nil nil nil
 375    nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
 376    nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
 377    nil 165 nil nil nil nil 153 nil 157 nil nil nil 154 nil nil nil
 378    133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
 379    nil 164 149 162 147 nil 148 246 155 151 163 150 129 nil nil 152]
 380   "Table for converting ISO-8859-1 characters into codepage 865 glyphs.")
 381 (setplist 'cp865-decode-table
 382           '(charset latin-iso8859-1 language "Latin-1" offset 160))
 383
 384 ;; Russian (Yes, another one!  This one's supposed to be used
 385 ;; on Windows as the Russian OEM code page.)
 386 (defvar cp866-decode-table
 387   [
 388    255 240 nil nil 242 nil nil 244 nil nil nil nil nil nil 246 nil
 389    128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
 390    144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
 391    160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
 392    224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
 393    252 241 nil nil 243 nil nil 245 nil nil nil nil nil nil 247 nil]
 394   "Table for converting ISO-8859-5 characters into codepage 866 glyphs.")
 395 (setplist 'cp866-decode-table
 396           '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
 397
 398 ;; Greek (yes, another one!)
 399 (defvar cp869-decode-table
 400   [
 401    255 139 140 156 nil nil 138 245 249 151 nil 174 137 240 nil 142
 402    248 241 153 154 239 247 134 136 141 143 144 175 146 171 149 152
 403    161 164 165 166 167 168 169 170 172 173 181 182 183 184 189 190
 404    198 199 nil 207 208 209 210 211 212 213 145 150 155 157 158 159
 405    252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
 406    234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
 407   "Table for converting ISO-8859-7 characters into codepage 869 glyphs.")
 408 (setplist 'cp869-decode-table
 409           '(charset greek-iso8859-7 language "Greek" offset 160))
 410
 411 ;; Greek OEM codepage used by Windows
 412 (defvar cp737-decode-table
 413   [
 414    255 nil nil nil nil nil 179 nil nil nil nil nil nil 196 nil nil
 415    248 241 253 nil nil nil 234 250 235 236 237 nil 238 nil 239 240
 416    nil 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
 417    143 144 nil 145 146 147 148 149 150 151 244 245 225 226 227 229
 418    nil 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
 419    167 168 170 169 171 172 173 174 175 224 228 232 230 231 233 nil]
 420   "Table for converting ISO-8859-7 characters into codepage 737 glyphs.")
 421 (setplist 'cp737-decode-table
 422           '(charset greek-iso8859-7 language "Greek" offset 160))
 423
 424 ;; Conversion from codepages 770-775 to Latin-4 for Baltic countries.
 425 ;; FIXME: Once we support Latin-7, these should be remapped into it.
 426 (defvar cp770-decode-table
 427   [
 428    255 143 nil nil 155 nil 156 nil 157 159 137 168 nil 196 146 nil
 429    248 133 nil nil nil nil 134 nil nil 158 136 152 nil nil 145 nil
 430    160 nil nil nil 142 nil nil 173 128 nil 139 nil 144 nil nil 161
 431    nil nil nil 163 nil 149 153 nil nil 167 nil nil 154 nil 166 225
 432    131 nil nil nil 132 nil nil 141 135 nil 138 nil 130 nil nil 140
 433    nil nil nil 162 nil 147 148 247 nil 151 nil nil 129 nil 150 nil]
 434   "Table for converting ISO-8859-4 characters into codepage 770 glyphs.")
 435 (setplist 'cp770-decode-table
 436           '(charset latin-iso8859-4 language "Latin-4" offset 160))
 437
 438 (defvar cp773-decode-table
 439   [
 440    255 220 nil 138 150 nil 234 190 166 246 237 149 173 196 252 nil
 441    208 nil nil 139 239 nil 235 nil nil 247 137 133 136 nil 253 nil
 442    160 nil nil nil 142 143 146 244 222 144 240 nil 242 nil nil 161
 443    nil 238 226 232 nil 229 153 158 157 248 nil nil 154 nil 250 225
 444    131 nil nil nil 132 134 145 245 223 130 241 nil 243 nil nil 140
 445    nil 236 147 233 nil 228 148 198 155 249 nil nil 129 nil 251 nil]
 446   "Table for converting ISO-8859-4 characters into codepage 773 glyphs.")
 447 (setplist 'cp773-decode-table
 448           '(charset latin-iso8859-4 language "Latin-4" offset 160))
 449
 450 (defvar cp774-decode-table
 451   [
 452    255 181 nil nil 155 nil nil nil 245 190 nil nil nil 196 207 nil
 453    248 208 nil nil nil nil nil nil nil 213 nil nil nil nil 216 nil
 454    nil nil nil nil 142 143 146 189 182 144 183 nil 184 nil nil nil
 455    nil nil nil nil nil nil 153 nil nil 198 nil nil 154 nil 199 225
 456    nil 160 nil nil 132 134 145 212 209 130 210 137 211 161 140 nil
 457    nil nil nil nil 147 nil 148 246 237 214 163 150 129 nil 215 248]
 458   "Table for converting ISO-8859-4 characters into codepage 774 glyphs.")
 459 (setplist 'cp774-decode-table
 460           '(charset latin-iso8859-4 language "Latin-4" offset 160))
 461
 462 (defvar cp775-decode-table
 463   [
 464    255 181 nil 138 150 nil 234 245 166 190 237 149 173 240 207 nil
 465    248 208 nil 139 239 nil 235 nil nil 213 137 133 136 nil 216 nil
 466    160 nil nil nil 142 143 146 189 182 144 183 nil 184 nil nil 161
 467    nil 238 226 232 nil 229 153 158 157 198 nil nil 154 nil 199 225
 468    131 nil nil nil 132 134 145 212 209 130 210 nil 211 nil nil 140
 469    nil 236 147 233 nil 228 148 247 155 214 nil nil 129 nil 215 nil]
 470   "Table for converting ISO-8859-4 characters into codepage 775 glyphs.")
 471 (setplist 'cp775-decode-table
 472           '(charset latin-iso8859-4 language "Latin-4" offset 160))
 473
 474 ;; Support for the Windows 12xx series of codepages that MS has
 475 ;; butchered from the ISO-8859 specs. This does not add support for
 476 ;; the extended characters that MS has added in the 128 - 159 coding
 477 ;; range, only translates those characters that can be expressed in
 478 ;; the corresponding iso-8859 charset.
 479
 480 ;; Codepage Mapping:
 481 ;;
 482 ;; Windows-1250: ISO-8859-2 (Central Europe) - differs in some positions
 483 ;; Windows-1251: ISO-8859-5 (Cyrillic)       - differs wildly
 484 ;; Windows-1252: ISO-8859-1 (West Europe)    - exact match
 485 ;; Windows-1253: ISO-8859-7 (Greek)          - differs in some positions
 486 ;; Windows-1254: ISO-8859-9 (Turkish)        - exact match
 487 ;; Windows-1255: ISO-8859-8 (Hebrew)         - exact match
 488 ;; Windows-1256: ISO-8859-6 (Arabic)         - half match
 489 ;; Windows-1257: ISO-8859-4 (Baltic)         - differs, future Latin-7
 490 ;; Windows-1258: VISCII (Vietnamese)         - Completely different
 491
 492 (defvar cp1250-decode-table
 493   [
 494     160 165 162 163 164 188 140 167 168 138 170 141 143 173 142 175
 495     176 185 178 179 180 190 156 161 184 154 186 157 159 189 158 191
 496     192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
 497     208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
 498     224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
 499     240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 ]
 500   "ISO-8859-2 to Windows-1250 (Central Europe) codepage decoding table.")
 501 (setplist 'cp1250-decode-table
 502           '(charset latin-iso8859-2 language "Latin-2" offset 160))
 503
 504 (defvar cp1251-decode-table
 505   [
 506     160 168 128 129 170 189 178 175 163 138 140 142 141 173 161 143
 507     192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
 508     208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
 509     224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
 510     240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
 511     185 184 144 131 186 190 179 191 188 154 156 158 157 167 162 159 ]
 512   "ISO-8859-5 to Windows-1251 (Cyrillic) codepage decoding table.")
 513 (setplist 'cp1251-decode-table
 514           '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
 515
 516 ;; cp1253 is missing nbsp so we cannot quite translate perfectly. It
 517 ;; also has two micro/mu characters which would require more complex
 518 ;; processing to accomodate.
 519 (defvar cp1253-decode-table
 520   [
 521     nil 145 146 163 nil nil 166 167 168 169 nil 171 172 173 nil 151
 522     176 177 178 179 180 161 162 183 184 185 186 187 188 189 190 191
 523     192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
 524     208 209 nil 211 212 213 214 215 216 217 218 219 220 221 222 223
 525     224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
 526     240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 nil ]
 527   "ISO-8859-7 to Windows-1253 (Greek) codepage decoding table.")
 528 (setplist 'cp1253-decode-table
 529           '(charset greek-iso8859-7 language "Greek" offset 160))
 530
 531 ;; Since Latin-7 is not yet official, and Emacs does not support it,
 532 ;; provide translation between Windows-1257 and Latin-4 the best we
 533 ;; can.
 534 (defvar cp1257-decode-table
 535   [
 536     160 192 nil 170 164 nil 207 167 nil 208 199 204 nil 173 222 nil
 537     176 224 nil 186 nil nil 239 nil nil 240 231 236 nil nil 254 nil
 538     194 nil nil nil 196 197 175 193 200 201 198 nil 203 nil nil 206
 539     nil 210 212 205 nil 213 214 215 168 216 nil nil 220 nil 219 223
 540     226 nil nil nil 228 229 191 225 232 233 230 nil 235 nil nil 238
 541     nil 242 244 237 nil 245 246 247 184 248 nil nil 252 nil 251 nil ]
 542   "ISO-8859-4 to Windows-1257 (Baltic) codepage decoding table.")
 543 (setplist 'cp1257-decode-table
 544           '(charset latin-iso8859-4 language "Latin-4" offset 160))
 545
 546 ;;;###autoload
 547 (defun cp-make-coding-systems-for-codepage (codepage iso-name offset)
 548   "Create a coding system to convert IBM CODEPAGE into charset ISO-NAME
 549 whose first character is at offset OFFSET from the beginning of 8-bit
 550 ASCII table.
 551
 552 The created coding system has the usual 3 subsidiary systems: for Unix-,
 553 DOS- and Mac-style EOL conversion.  However, unlike built-in coding
 554 systems, the Mac-style EOL conversion is currently not supported by the
 555 decoder and encoder created by this function."
 556   (let* ((decode-table (intern (format "%s-decode-table" codepage)))
 557          (nonascii-table
 558           (intern (format "%s-nonascii-translation-table" codepage)))
 559          (decode-translation
 560           (intern (format "%s-decode-translation-table" codepage)))
 561          (encode-translation
 562           (intern (format "%s-encode-translation-table" codepage))))
 563     (set nonascii-table
 564          (make-translation-table-from-vector
 565           (cp-decoding-vector-for-codepage
 566            (symbol-value decode-table) iso-name offset)))
 567     (define-translation-table encode-translation
 568       (char-table-extra-slot (symbol-value nonascii-table) 0))
 569     ;; For charsets other than ascii, eight-bit-* and ISO-NAME, set
 570     ;; `?' for one-column charsets, and some Japanese character for
 571     ;; wide-column charsets.  CCL encoder convert that Japanese
 572     ;; character to either dos-unsupported-char-glyph or "??".
 573     (let ((tbl (char-table-extra-slot (symbol-value nonascii-table) 0))
 574           (undef (if (eq system-type 'ms-dos)
 575                      (if dos-unsupported-char-glyph
 576                          (logand dos-unsupported-char-glyph 255)
 577                        127)
 578                    ??))
 579           (charsets (delq 'ascii
 580                           (delq 'eight-bit-control
 581                                 (delq 'eight-bit-graphic
 582                                       (delq iso-name
 583                                             (copy-sequence charset-list))))))
 584           (wide-column-char (make-char 'japanese-jisx0208 32 32)))
 585       (while charsets
 586         (aset tbl (make-char (car charsets))
 587               (if (= (charset-width (car charsets)) 1) undef wide-column-char))
 588         (setq charsets (cdr charsets))))
 589     (define-translation-table decode-translation
 590       (symbol-value nonascii-table))
 591     (cp-coding-system-for-codepage-1
 592      (intern codepage) ?D iso-name decode-translation encode-translation)
 593     ))
 594
 595 (defun cp-codepage-decoder (codepage)
 596   "If CODEPAGE is the name of a supported codepage, return its decode table.
 597 Otherwise return nil."
 598   (let ((cp (if (symbolp codepage) (symbol-name codepage) codepage)))
 599     (cond
 600      ((stringp cp)
 601       (intern-soft (format "%s-decode-table" cp)))
 602      (t nil))))
 603
 604 ;;;###autoload
 605 (defun cp-charset-for-codepage (codepage)
 606   "Return the charset for which there is a translation table to DOS CODEPAGE.
 607 CODEPAGE must be the name of a DOS codepage, a string."
 608   (let ((cp-decoder (cp-codepage-decoder codepage)))
 609     (if (null cp-decoder)
 610         (error "Unsupported codepage %s" codepage)
 611       (get cp-decoder 'charset))))
 612
 613 ;;;###autoload
 614 (defun cp-language-for-codepage (codepage)
 615   "Return the name of the MULE language environment for CODEPAGE.
 616 CODEPAGE must be the name of a DOS codepage, a string."
 617   (let ((cp-decoder (cp-codepage-decoder codepage)))
 618     (if (null cp-decoder)
 619         (error "Unsupported codepage %s" codepage)
 620       (get cp-decoder 'language))))
 621
 622 ;;;###autoload
 623 (defun cp-offset-for-codepage (codepage)
 624   "Return the offset to be used in setting up coding systems for CODEPAGE.
 625 CODEPAGE must be the name of a DOS codepage, a string."
 626   (let ((cp-decoder (cp-codepage-decoder codepage)))
 627     (if (null cp-decoder)
 628         (error "Unsupported codepage %s" codepage)
 629       (get cp-decoder 'offset))))
 630
 631 ;;;###autoload
 632 (defun cp-supported-codepages ()
 633   "Return an alist of supported codepages.
 634
 635 Each association in the alist has the form (NNN . CHARSET), where NNN is the
 636 codepage number, and CHARSET is the MULE charset which is the closest match
 637 for the character set supported by that codepage.
 638
 639 A codepage NNN is supported if a variable called `cpNNN-decode-table' exists,
 640 is a vector, and has a charset property."
 641   (save-match-data
 642     (let (alist chset sname)
 643       (mapatoms
 644        (function
 645         (lambda (sym)
 646           (if (and (boundp sym)
 647                    (string-match "\\`cp\\([1-9][0-9][0-9][0-9]?\\)-decode-table\\'"
 648                                  (setq sname (symbol-name sym)))
 649                    (vectorp (symbol-value sym))
 650                    (setq chset (get sym 'charset)))
 651               (setq alist
 652                     (cons (cons (match-string 1 sname) chset) alist))))))
 653       alist)))
 654
 655 ;;;###autoload
 656 (defun codepage-setup (codepage)
 657   "Create a coding system cpCODEPAGE to support the IBM codepage CODEPAGE.
 658
 659 These coding systems are meant for encoding and decoding 8-bit non-ASCII
 660 characters used by the IBM codepages, typically in conjunction with files
 661 read/written by MS-DOS software, or for display on the MS-DOS terminal."
 662   (interactive
 663    (let ((completion-ignore-case t)
 664          (candidates (cp-supported-codepages)))
 665      (list (completing-read "Setup DOS Codepage (default 437): " candidates
 666                             nil t nil nil "437"))))
 667   (let* ((cp (format "cp%s" codepage))
 668          (cp-defined (intern-soft cp)))
 669     (or (and cp-defined  ;; avoid defining if already defined
 670              (coding-system-p cp-defined))
 671         (cp-make-coding-systems-for-codepage
 672          cp (cp-charset-for-codepage cp) (cp-offset-for-codepage cp)))))
 673
 674 ;; Add DOS codepages to `non-iso-charset-alist'.
 675 (eval-after-load "mule-diag"
 676   '(let ((tail (cp-supported-codepages))
 677          elt)
 678      (while tail
 679        (setq elt (car tail) tail (cdr tail))
 680        ;; Now ELT is (CODEPAGE . CHARSET), where CODEPAGE is a string
 681        ;; (e.g. "850"), CHARSET is a charset that characters in CODEPAGE
 682        ;; are mapped to.
 683        (unless (assq (intern (concat "cp" (car elt))) non-iso-charset-alist)
 684          (setq non-iso-charset-alist
 685                (cons (list (intern (concat "cp" (car elt)))
 686                            (list 'ascii (cdr elt))
 687                            `(lambda (code)
 688                               (decode-codepage-char ,(string-to-int (car elt))
 689                                                     code))
 690                            (list (list 0 255)))
 691                      non-iso-charset-alist))))))
 692
 693 (provide 'codepage)
 694
 695 ;;; arch-tag: 80328de8-b94e-4386-be26-5876105731f0
 696 ;;; codepage.el ends here