src/code/external-formats/enc-win.lisp

   1 (in-package "SB!IMPL")
   2
   3 (define-unibyte-mapper cp1250->code-mapper code->cp1250-mapper
   4   (#x80 #x20AC) ; EURO SIGN
   5   (#x81 nil)
   6   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
   7   (#x83 nil)
   8   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
   9   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
  10   (#x86 #x2020) ; DAGGER
  11   (#x87 #x2021) ; DOUBLE DAGGER
  12   (#x88 nil)
  13   (#x89 #x2030) ; PER MILLE SIGN
  14   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  15   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
  16   (#x8C #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
  17   (#x8D #x0164) ; LATIN CAPITAL LETTER T WITH CARON
  18   (#x8E #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
  19   (#x8F #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
  20   (#x90 nil)
  21   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
  22   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
  23   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
  24   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  25   (#x95 #x2022) ; BULLET
  26   (#x96 #x2013) ; EN DASH
  27   (#x97 #x2014) ; EM DASH
  28   (#x98 nil)
  29   (#x99 #x2122) ; TRADE MARK SIGN
  30   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
  31   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
  32   (#x9C #x015B) ; LATIN SMALL LETTER S WITH ACUTE
  33   (#x9D #x0165) ; LATIN SMALL LETTER T WITH CARON
  34   (#x9E #x017E) ; LATIN SMALL LETTER Z WITH CARON
  35   (#x9F #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
  36   (#xA1 #x02C7) ; CARON
  37   (#xA2 #x02D8) ; BREVE
  38   (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
  39   (#xA5 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
  40   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
  41   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
  42   (#xB2 #x02DB) ; OGONEK
  43   (#xB3 #x0142) ; LATIN SMALL LETTER L WITH STROKE
  44   (#xB9 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
  45   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
  46   (#xBC #x013D) ; LATIN CAPITAL LETTER L WITH CARON
  47   (#xBD #x02DD) ; DOUBLE ACUTE ACCENT
  48   (#xBE #x013E) ; LATIN SMALL LETTER L WITH CARON
  49   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
  50   (#xC0 #x0154) ; LATIN CAPITAL LETTER R WITH ACUTE
  51   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
  52   (#xC5 #x0139) ; LATIN CAPITAL LETTER L WITH ACUTE
  53   (#xC6 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
  54   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
  55   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
  56   (#xCC #x011A) ; LATIN CAPITAL LETTER E WITH CARON
  57   (#xCF #x010E) ; LATIN CAPITAL LETTER D WITH CARON
  58   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
  59   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
  60   (#xD2 #x0147) ; LATIN CAPITAL LETTER N WITH CARON
  61   (#xD5 #x0150) ; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
  62   (#xD8 #x0158) ; LATIN CAPITAL LETTER R WITH CARON
  63   (#xD9 #x016E) ; LATIN CAPITAL LETTER U WITH RING ABOVE
  64   (#xDB #x0170) ; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
  65   (#xDE #x0162) ; LATIN CAPITAL LETTER T WITH CEDILLA
  66   (#xE0 #x0155) ; LATIN SMALL LETTER R WITH ACUTE
  67   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
  68   (#xE5 #x013A) ; LATIN SMALL LETTER L WITH ACUTE
  69   (#xE6 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
  70   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
  71   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
  72   (#xEC #x011B) ; LATIN SMALL LETTER E WITH CARON
  73   (#xEF #x010F) ; LATIN SMALL LETTER D WITH CARON
  74   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
  75   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
  76   (#xF2 #x0148) ; LATIN SMALL LETTER N WITH CARON
  77   (#xF5 #x0151) ; LATIN SMALL LETTER O WITH DOUBLE ACUTE
  78   (#xF8 #x0159) ; LATIN SMALL LETTER R WITH CARON
  79   (#xF9 #x016F) ; LATIN SMALL LETTER U WITH RING ABOVE
  80   (#xFB #x0171) ; LATIN SMALL LETTER U WITH DOUBLE ACUTE
  81   (#xFE #x0163) ; LATIN SMALL LETTER T WITH CEDILLA
  82   (#xFF #x02D9) ; DOT ABOVE
  83 )
  84
  85 (declaim (inline get-cp1250-bytes))
  86 (defun get-cp1250-bytes (string pos)
  87   (declare (optimize speed (safety 0))
  88            (type simple-string string)
  89            (type array-range pos))
  90   (get-latin-bytes #'code->cp1250-mapper :cp1250 string pos))
  91
  92 (defun string->cp1250 (string sstart send null-padding)
  93   (declare (optimize speed (safety 0))
  94            (type simple-string string)
  95            (type array-range sstart send))
  96   (values (string->latin% string sstart send #'get-cp1250-bytes null-padding)))
  97
  98 (defmacro define-cp1250->string* (accessor type)
  99   (declare (ignore type))
 100   (let ((name (make-od-name 'cp1250->string* accessor)))
 101     `(progn
 102       (defun ,name (string sstart send array astart aend)
 103         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1250->code-mapper)))))
 104
 105 (instantiate-octets-definition define-cp1250->string*)
 106
 107 (defmacro define-cp1250->string (accessor type)
 108   (declare (ignore type))
 109   `(defun ,(make-od-name 'cp1250->string accessor) (array astart aend)
 110     (,(make-od-name 'latin->string accessor) array astart aend #'cp1250->code-mapper)))
 111
 112 (instantiate-octets-definition define-cp1250->string)
 113
 114 (add-external-format-funs '(:cp1250 :|cp1250| :windows-1250 :|windows-1250|)
 115                           '(cp1250->string-aref string->cp1250))
 116
 117 (define-external-format (:cp1250 :|cp1250| :windows-1250 :|windows-1250|)
 118     1 t
 119     (let ((cp1250-byte (code->cp1250-mapper bits)))
 120       (if cp1250-byte
 121           (setf (sap-ref-8 sap tail) cp1250-byte)
 122           (external-format-encoding-error stream bits)))
 123     (let ((code (cp1250->code-mapper byte)))
 124       (if code
 125           (code-char code)
 126           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 127
 128 (define-unibyte-mapper cp1251->code-mapper code->cp1251-mapper
 129   (#x80 #x0402) ; CYRILLIC CAPITAL LETTER DJE
 130   (#x81 #x0403) ; CYRILLIC CAPITAL LETTER GJE
 131   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 132   (#x83 #x0453) ; CYRILLIC SMALL LETTER GJE
 133   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 134   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 135   (#x86 #x2020) ; DAGGER
 136   (#x87 #x2021) ; DOUBLE DAGGER
 137   (#x88 nil)
 138   (#x89 #x2030) ; PER MILLE SIGN
 139   (#x8A #x0409) ; CYRILLIC CAPITAL LETTER LJE
 140   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 141   (#x8C #x040A) ; CYRILLIC CAPITAL LETTER NJE
 142   (#x8D #x040C) ; CYRILLIC CAPITAL LETTER KJE
 143   (#x8E #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 144   (#x8F #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 145   (#x90 #x0452) ; CYRILLIC SMALL LETTER DJE
 146   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 147   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 148   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 149   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 150   (#x95 #x2022) ; BULLET
 151   (#x96 #x2013) ; EN DASH
 152   (#x97 #x2014) ; EM DASH
 153   (#x98 nil)
 154   (#x99 #x2122) ; TRADE MARK SIGN
 155   (#x9A #x0459) ; CYRILLIC SMALL LETTER LJE
 156   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 157   (#x9C #x045A) ; CYRILLIC SMALL LETTER NJE
 158   (#x9D #x045C) ; CYRILLIC SMALL LETTER KJE
 159   (#x9E #x045B) ; CYRILLIC SMALL LETTER TSHE
 160   (#x9F #x045F) ; CYRILLIC SMALL LETTER DZHE
 161   (#xA1 #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 162   (#xA2 #x045E) ; CYRILLIC SMALL LETTER SHORT U
 163   (#xA3 #x0408) ; CYRILLIC CAPITAL LETTER JE
 164   (#xA5 #x0490) ; CYRILLIC CAPITAL LETTER GHE WITH UPTURN
 165   (#xA8 #x0401) ; CYRILLIC CAPITAL LETTER IO
 166   (#xAA #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 167   (#xAF #x0407) ; CYRILLIC CAPITAL LETTER YI
 168   (#xB2 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 169   (#xB3 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 170   (#xB4 #x0491) ; CYRILLIC SMALL LETTER GHE WITH UPTURN
 171   (#xB8 #x0451) ; CYRILLIC SMALL LETTER IO
 172   (#xB9 #x2116) ; NUMERO SIGN
 173   (#xBA #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 174   (#xBC #x0458) ; CYRILLIC SMALL LETTER JE
 175   (#xBD #x0405) ; CYRILLIC CAPITAL LETTER DZE
 176   (#xBE #x0455) ; CYRILLIC SMALL LETTER DZE
 177   (#xBF #x0457) ; CYRILLIC SMALL LETTER YI
 178   (#xC0 #x0410) ; CYRILLIC CAPITAL LETTER A
 179   (#xC1 #x0411) ; CYRILLIC CAPITAL LETTER BE
 180   (#xC2 #x0412) ; CYRILLIC CAPITAL LETTER VE
 181   (#xC3 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 182   (#xC4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 183   (#xC5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 184   (#xC6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 185   (#xC7 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 186   (#xC8 #x0418) ; CYRILLIC CAPITAL LETTER I
 187   (#xC9 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 188   (#xCA #x041A) ; CYRILLIC CAPITAL LETTER KA
 189   (#xCB #x041B) ; CYRILLIC CAPITAL LETTER EL
 190   (#xCC #x041C) ; CYRILLIC CAPITAL LETTER EM
 191   (#xCD #x041D) ; CYRILLIC CAPITAL LETTER EN
 192   (#xCE #x041E) ; CYRILLIC CAPITAL LETTER O
 193   (#xCF #x041F) ; CYRILLIC CAPITAL LETTER PE
 194   (#xD0 #x0420) ; CYRILLIC CAPITAL LETTER ER
 195   (#xD1 #x0421) ; CYRILLIC CAPITAL LETTER ES
 196   (#xD2 #x0422) ; CYRILLIC CAPITAL LETTER TE
 197   (#xD3 #x0423) ; CYRILLIC CAPITAL LETTER U
 198   (#xD4 #x0424) ; CYRILLIC CAPITAL LETTER EF
 199   (#xD5 #x0425) ; CYRILLIC CAPITAL LETTER HA
 200   (#xD6 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 201   (#xD7 #x0427) ; CYRILLIC CAPITAL LETTER CHE
 202   (#xD8 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 203   (#xD9 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 204   (#xDA #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 205   (#xDB #x042B) ; CYRILLIC CAPITAL LETTER YERU
 206   (#xDC #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 207   (#xDD #x042D) ; CYRILLIC CAPITAL LETTER E
 208   (#xDE #x042E) ; CYRILLIC CAPITAL LETTER YU
 209   (#xDF #x042F) ; CYRILLIC CAPITAL LETTER YA
 210   (#xE0 #x0430) ; CYRILLIC SMALL LETTER A
 211   (#xE1 #x0431) ; CYRILLIC SMALL LETTER BE
 212   (#xE2 #x0432) ; CYRILLIC SMALL LETTER VE
 213   (#xE3 #x0433) ; CYRILLIC SMALL LETTER GHE
 214   (#xE4 #x0434) ; CYRILLIC SMALL LETTER DE
 215   (#xE5 #x0435) ; CYRILLIC SMALL LETTER IE
 216   (#xE6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 217   (#xE7 #x0437) ; CYRILLIC SMALL LETTER ZE
 218   (#xE8 #x0438) ; CYRILLIC SMALL LETTER I
 219   (#xE9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
 220   (#xEA #x043A) ; CYRILLIC SMALL LETTER KA
 221   (#xEB #x043B) ; CYRILLIC SMALL LETTER EL
 222   (#xEC #x043C) ; CYRILLIC SMALL LETTER EM
 223   (#xED #x043D) ; CYRILLIC SMALL LETTER EN
 224   (#xEE #x043E) ; CYRILLIC SMALL LETTER O
 225   (#xEF #x043F) ; CYRILLIC SMALL LETTER PE
 226   (#xF0 #x0440) ; CYRILLIC SMALL LETTER ER
 227   (#xF1 #x0441) ; CYRILLIC SMALL LETTER ES
 228   (#xF2 #x0442) ; CYRILLIC SMALL LETTER TE
 229   (#xF3 #x0443) ; CYRILLIC SMALL LETTER U
 230   (#xF4 #x0444) ; CYRILLIC SMALL LETTER EF
 231   (#xF5 #x0445) ; CYRILLIC SMALL LETTER HA
 232   (#xF6 #x0446) ; CYRILLIC SMALL LETTER TSE
 233   (#xF7 #x0447) ; CYRILLIC SMALL LETTER CHE
 234   (#xF8 #x0448) ; CYRILLIC SMALL LETTER SHA
 235   (#xF9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 236   (#xFA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 237   (#xFB #x044B) ; CYRILLIC SMALL LETTER YERU
 238   (#xFC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 239   (#xFD #x044D) ; CYRILLIC SMALL LETTER E
 240   (#xFE #x044E) ; CYRILLIC SMALL LETTER YU
 241   (#xFF #x044F) ; CYRILLIC SMALL LETTER YA
 242 )
 243
 244 (declaim (inline get-cp1251-bytes))
 245 (defun get-cp1251-bytes (string pos)
 246   (declare (optimize speed (safety 0))
 247            (type simple-string string)
 248            (type array-range pos))
 249   (get-latin-bytes #'code->cp1251-mapper :cp1251 string pos))
 250
 251 (defun string->cp1251 (string sstart send null-padding)
 252   (declare (optimize speed (safety 0))
 253            (type simple-string string)
 254            (type array-range sstart send))
 255   (values (string->latin% string sstart send #'get-cp1251-bytes null-padding)))
 256
 257 (defmacro define-cp1251->string* (accessor type)
 258   (declare (ignore type))
 259   (let ((name (make-od-name 'cp1251->string* accessor)))
 260     `(progn
 261       (defun ,name (string sstart send array astart aend)
 262         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1251->code-mapper)))))
 263
 264 (instantiate-octets-definition define-cp1251->string*)
 265
 266 (defmacro define-cp1251->string (accessor type)
 267   (declare (ignore type))
 268   `(defun ,(make-od-name 'cp1251->string accessor) (array astart aend)
 269     (,(make-od-name 'latin->string accessor) array astart aend #'cp1251->code-mapper)))
 270
 271 (instantiate-octets-definition define-cp1251->string)
 272
 273 (add-external-format-funs '(:cp1251 :|cp1251|  :windows-1251 :|windows-1251|)
 274                           '(cp1251->string-aref string->cp1251))
 275
 276 (define-external-format (:cp1251 :|cp1251| :windows-1251 :|windows-1251|)
 277     1 t
 278     (let ((cp1251-byte (code->cp1251-mapper bits)))
 279       (if cp1251-byte
 280           (setf (sap-ref-8 sap tail) cp1251-byte)
 281           (external-format-encoding-error stream bits)))
 282     (let ((code (cp1251->code-mapper byte)))
 283       (if code
 284           (code-char code)
 285           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 286
 287 (define-unibyte-mapper cp1252->code-mapper code->cp1252-mapper
 288   (#x80 #x20AC) ; EURO SIGN
 289   (#x81 nil)
 290   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 291   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 292   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 293   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 294   (#x86 #x2020) ; DAGGER
 295   (#x87 #x2021) ; DOUBLE DAGGER
 296   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 297   (#x89 #x2030) ; PER MILLE SIGN
 298   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 299   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 300   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 301   (#x8D nil)
 302   (#x8E #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 303   (#x8F nil)
 304   (#x90 nil)
 305   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 306   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 307   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 308   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 309   (#x95 #x2022) ; BULLET
 310   (#x96 #x2013) ; EN DASH
 311   (#x97 #x2014) ; EM DASH
 312   (#x98 #x02DC) ; SMALL TILDE
 313   (#x99 #x2122) ; TRADE MARK SIGN
 314   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
 315   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 316   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 317   (#x9D nil)
 318   (#x9E #x017E) ; LATIN SMALL LETTER Z WITH CARON
 319   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
 320 )
 321
 322 (declaim (inline get-cp1252-bytes))
 323 (defun get-cp1252-bytes (string pos)
 324   (declare (optimize speed (safety 0))
 325            (type simple-string string)
 326            (type array-range pos))
 327   (get-latin-bytes #'code->cp1252-mapper :cp1252 string pos))
 328
 329 (defun string->cp1252 (string sstart send null-padding)
 330   (declare (optimize speed (safety 0))
 331            (type simple-string string)
 332            (type array-range sstart send))
 333   (values (string->latin% string sstart send #'get-cp1252-bytes null-padding)))
 334
 335 (defmacro define-cp1252->string* (accessor type)
 336   (declare (ignore type))
 337   (let ((name (make-od-name 'cp1252->string* accessor)))
 338     `(progn
 339       (defun ,name (string sstart send array astart aend)
 340         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1252->code-mapper)))))
 341
 342 (instantiate-octets-definition define-cp1252->string*)
 343
 344 (defmacro define-cp1252->string (accessor type)
 345   (declare (ignore type))
 346   `(defun ,(make-od-name 'cp1252->string accessor) (array astart aend)
 347     (,(make-od-name 'latin->string accessor) array astart aend #'cp1252->code-mapper)))
 348
 349 (instantiate-octets-definition define-cp1252->string)
 350
 351 (add-external-format-funs '(:cp1252 :|cp1252| :windows-1252 :|windows-1252|)
 352                           '(cp1252->string-aref string->cp1252))
 353
 354 (define-external-format (:cp1252 :|cp1252| :windows-1252 :|windows-1252|)
 355     1 t
 356     (let ((cp1252-byte (code->cp1252-mapper bits)))
 357       (if cp1252-byte
 358           (setf (sap-ref-8 sap tail) cp1252-byte)
 359           (external-format-encoding-error stream bits)))
 360     (let ((code (cp1252->code-mapper byte)))
 361       (if code
 362           (code-char code)
 363           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 364
 365 (define-unibyte-mapper cp1253->code-mapper code->cp1253-mapper
 366   (#x80 #x20AC) ; EURO SIGN
 367   (#x81 nil)
 368   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 369   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 370   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 371   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 372   (#x86 #x2020) ; DAGGER
 373   (#x87 #x2021) ; DOUBLE DAGGER
 374   (#x88 nil)
 375   (#x89 #x2030) ; PER MILLE SIGN
 376   (#x8A nil)
 377   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 378   (#x8C nil)
 379   (#x8D nil)
 380   (#x8E nil)
 381   (#x8F nil)
 382   (#x90 nil)
 383   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 384   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 385   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 386   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 387   (#x95 #x2022) ; BULLET
 388   (#x96 #x2013) ; EN DASH
 389   (#x97 #x2014) ; EM DASH
 390   (#x98 nil)
 391   (#x99 #x2122) ; TRADE MARK SIGN
 392   (#x9A nil)
 393   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 394   (#x9C nil)
 395   (#x9D nil)
 396   (#x9E nil)
 397   (#x9F nil)
 398   (#xA1 #x0385) ; GREEK DIALYTIKA TONOS
 399   (#xA2 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
 400   (#xAA nil)
 401   (#xAF #x2015) ; HORIZONTAL BAR
 402   (#xB4 #x0384) ; GREEK TONOS
 403   (#xB8 #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
 404   (#xB9 #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
 405   (#xBA #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
 406   (#xBC #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
 407   (#xBE #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
 408   (#xBF #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
 409   (#xC0 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
 410   (#xC1 #x0391) ; GREEK CAPITAL LETTER ALPHA
 411   (#xC2 #x0392) ; GREEK CAPITAL LETTER BETA
 412   (#xC3 #x0393) ; GREEK CAPITAL LETTER GAMMA
 413   (#xC4 #x0394) ; GREEK CAPITAL LETTER DELTA
 414   (#xC5 #x0395) ; GREEK CAPITAL LETTER EPSILON
 415   (#xC6 #x0396) ; GREEK CAPITAL LETTER ZETA
 416   (#xC7 #x0397) ; GREEK CAPITAL LETTER ETA
 417   (#xC8 #x0398) ; GREEK CAPITAL LETTER THETA
 418   (#xC9 #x0399) ; GREEK CAPITAL LETTER IOTA
 419   (#xCA #x039A) ; GREEK CAPITAL LETTER KAPPA
 420   (#xCB #x039B) ; GREEK CAPITAL LETTER LAMDA
 421   (#xCC #x039C) ; GREEK CAPITAL LETTER MU
 422   (#xCD #x039D) ; GREEK CAPITAL LETTER NU
 423   (#xCE #x039E) ; GREEK CAPITAL LETTER XI
 424   (#xCF #x039F) ; GREEK CAPITAL LETTER OMICRON
 425   (#xD0 #x03A0) ; GREEK CAPITAL LETTER PI
 426   (#xD1 #x03A1) ; GREEK CAPITAL LETTER RHO
 427   (#xD2 nil)
 428   (#xD3 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 429   (#xD4 #x03A4) ; GREEK CAPITAL LETTER TAU
 430   (#xD5 #x03A5) ; GREEK CAPITAL LETTER UPSILON
 431   (#xD6 #x03A6) ; GREEK CAPITAL LETTER PHI
 432   (#xD7 #x03A7) ; GREEK CAPITAL LETTER CHI
 433   (#xD8 #x03A8) ; GREEK CAPITAL LETTER PSI
 434   (#xD9 #x03A9) ; GREEK CAPITAL LETTER OMEGA
 435   (#xDA #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
 436   (#xDB #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
 437   (#xDC #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
 438   (#xDD #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
 439   (#xDE #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
 440   (#xDF #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
 441   (#xE0 #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
 442   (#xE1 #x03B1) ; GREEK SMALL LETTER ALPHA
 443   (#xE2 #x03B2) ; GREEK SMALL LETTER BETA
 444   (#xE3 #x03B3) ; GREEK SMALL LETTER GAMMA
 445   (#xE4 #x03B4) ; GREEK SMALL LETTER DELTA
 446   (#xE5 #x03B5) ; GREEK SMALL LETTER EPSILON
 447   (#xE6 #x03B6) ; GREEK SMALL LETTER ZETA
 448   (#xE7 #x03B7) ; GREEK SMALL LETTER ETA
 449   (#xE8 #x03B8) ; GREEK SMALL LETTER THETA
 450   (#xE9 #x03B9) ; GREEK SMALL LETTER IOTA
 451   (#xEA #x03BA) ; GREEK SMALL LETTER KAPPA
 452   (#xEB #x03BB) ; GREEK SMALL LETTER LAMDA
 453   (#xEC #x03BC) ; GREEK SMALL LETTER MU
 454   (#xED #x03BD) ; GREEK SMALL LETTER NU
 455   (#xEE #x03BE) ; GREEK SMALL LETTER XI
 456   (#xEF #x03BF) ; GREEK SMALL LETTER OMICRON
 457   (#xF0 #x03C0) ; GREEK SMALL LETTER PI
 458   (#xF1 #x03C1) ; GREEK SMALL LETTER RHO
 459   (#xF2 #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
 460   (#xF3 #x03C3) ; GREEK SMALL LETTER SIGMA
 461   (#xF4 #x03C4) ; GREEK SMALL LETTER TAU
 462   (#xF5 #x03C5) ; GREEK SMALL LETTER UPSILON
 463   (#xF6 #x03C6) ; GREEK SMALL LETTER PHI
 464   (#xF7 #x03C7) ; GREEK SMALL LETTER CHI
 465   (#xF8 #x03C8) ; GREEK SMALL LETTER PSI
 466   (#xF9 #x03C9) ; GREEK SMALL LETTER OMEGA
 467   (#xFA #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
 468   (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
 469   (#xFC #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
 470   (#xFD #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
 471   (#xFE #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
 472   (#xFF nil)
 473 )
 474
 475 (declaim (inline get-cp1253-bytes))
 476 (defun get-cp1253-bytes (string pos)
 477   (declare (optimize speed (safety 0))
 478            (type simple-string string)
 479            (type array-range pos))
 480   (get-latin-bytes #'code->cp1253-mapper :cp1253 string pos))
 481
 482 (defun string->cp1253 (string sstart send null-padding)
 483   (declare (optimize speed (safety 0))
 484            (type simple-string string)
 485            (type array-range sstart send))
 486   (values (string->latin% string sstart send #'get-cp1253-bytes null-padding)))
 487
 488 (defmacro define-cp1253->string* (accessor type)
 489   (declare (ignore type))
 490   (let ((name (make-od-name 'cp1253->string* accessor)))
 491     `(progn
 492       (defun ,name (string sstart send array astart aend)
 493         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1253->code-mapper)))))
 494
 495 (instantiate-octets-definition define-cp1253->string*)
 496
 497 (defmacro define-cp1253->string (accessor type)
 498   (declare (ignore type))
 499   `(defun ,(make-od-name 'cp1253->string accessor) (array astart aend)
 500     (,(make-od-name 'latin->string accessor) array astart aend #'cp1253->code-mapper)))
 501
 502 (instantiate-octets-definition define-cp1253->string)
 503
 504 (add-external-format-funs '(:cp1253 :|cp1253| :windows-1253 :|windows-1253|)
 505                           '(cp1253->string-aref string->cp1253))
 506
 507 (define-external-format (:cp1253 :|cp1253| :windows-1253 :|windows-1253|)
 508     1 t
 509     (let ((cp1253-byte (code->cp1253-mapper bits)))
 510       (if cp1253-byte
 511           (setf (sap-ref-8 sap tail) cp1253-byte)
 512           (external-format-encoding-error stream bits)))
 513     (let ((code (cp1253->code-mapper byte)))
 514       (if code
 515           (code-char code)
 516           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 517
 518 (define-unibyte-mapper cp1254->code-mapper code->cp1254-mapper
 519   (#x80 #x20AC) ; EURO SIGN
 520   (#x81 nil)
 521   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 522   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 523   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 524   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 525   (#x86 #x2020) ; DAGGER
 526   (#x87 #x2021) ; DOUBLE DAGGER
 527   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 528   (#x89 #x2030) ; PER MILLE SIGN
 529   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 530   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 531   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 532   (#x8D nil)
 533   (#x8E nil)
 534   (#x8F nil)
 535   (#x90 nil)
 536   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 537   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 538   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 539   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 540   (#x95 #x2022) ; BULLET
 541   (#x96 #x2013) ; EN DASH
 542   (#x97 #x2014) ; EM DASH
 543   (#x98 #x02DC) ; SMALL TILDE
 544   (#x99 #x2122) ; TRADE MARK SIGN
 545   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
 546   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 547   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 548   (#x9D nil)
 549   (#x9E nil)
 550   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
 551   (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 552   (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 553   (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 554   (#xF0 #x011F) ; LATIN SMALL LETTER G WITH BREVE
 555   (#xFD #x0131) ; LATIN SMALL LETTER DOTLESS I
 556   (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 557 )
 558
 559 (declaim (inline get-cp1254-bytes))
 560 (defun get-cp1254-bytes (string pos)
 561   (declare (optimize speed (safety 0))
 562            (type simple-string string)
 563            (type array-range pos))
 564   (get-latin-bytes #'code->cp1254-mapper :cp1254 string pos))
 565
 566 (defun string->cp1254 (string sstart send null-padding)
 567   (declare (optimize speed (safety 0))
 568            (type simple-string string)
 569            (type array-range sstart send))
 570   (values (string->latin% string sstart send #'get-cp1254-bytes null-padding)))
 571
 572 (defmacro define-cp1254->string* (accessor type)
 573   (declare (ignore type))
 574   (let ((name (make-od-name 'cp1254->string* accessor)))
 575     `(progn
 576       (defun ,name (string sstart send array astart aend)
 577         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1254->code-mapper)))))
 578
 579 (instantiate-octets-definition define-cp1254->string*)
 580
 581 (defmacro define-cp1254->string (accessor type)
 582   (declare (ignore type))
 583   `(defun ,(make-od-name 'cp1254->string accessor) (array astart aend)
 584     (,(make-od-name 'latin->string accessor) array astart aend #'cp1254->code-mapper)))
 585
 586 (instantiate-octets-definition define-cp1254->string)
 587
 588 (add-external-format-funs '(:cp1254 :|cp1254| :windows-1254 :|windows-1254|)
 589                           '(cp1254->string-aref string->cp1254))
 590
 591 (define-external-format (:cp1254 :|cp1254|)
 592     1 t
 593     (let ((cp1254-byte (code->cp1254-mapper bits)))
 594       (if cp1254-byte
 595           (setf (sap-ref-8 sap tail) cp1254-byte)
 596           (external-format-encoding-error stream bits)))
 597     (let ((code (cp1254->code-mapper byte)))
 598       (if code
 599           (code-char code)
 600           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 601
 602 (define-unibyte-mapper cp1255->code-mapper code->cp1255-mapper
 603   (#x80 #x20AC) ; EURO SIGN
 604   (#x81 nil)
 605   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 606   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 607   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 608   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 609   (#x86 #x2020) ; DAGGER
 610   (#x87 #x2021) ; DOUBLE DAGGER
 611   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 612   (#x89 #x2030) ; PER MILLE SIGN
 613   (#x8A nil)
 614   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 615   (#x8C nil)
 616   (#x8D nil)
 617   (#x8E nil)
 618   (#x8F nil)
 619   (#x90 nil)
 620   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 621   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 622   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 623   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 624   (#x95 #x2022) ; BULLET
 625   (#x96 #x2013) ; EN DASH
 626   (#x97 #x2014) ; EM DASH
 627   (#x98 #x02DC) ; SMALL TILDE
 628   (#x99 #x2122) ; TRADE MARK SIGN
 629   (#x9A nil)
 630   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 631   (#x9C nil)
 632   (#x9D nil)
 633   (#x9E nil)
 634   (#x9F nil)
 635   (#xA4 #x20AA) ; NEW SHEQEL SIGN
 636   (#xAA #x00D7) ; MULTIPLICATION SIGN
 637   (#xBA #x00F7) ; DIVISION SIGN
 638   (#xC0 #x05B0) ; HEBREW POINT SHEVA
 639   (#xC1 #x05B1) ; HEBREW POINT HATAF SEGOL
 640   (#xC2 #x05B2) ; HEBREW POINT HATAF PATAH
 641   (#xC3 #x05B3) ; HEBREW POINT HATAF QAMATS
 642   (#xC4 #x05B4) ; HEBREW POINT HIRIQ
 643   (#xC5 #x05B5) ; HEBREW POINT TSERE
 644   (#xC6 #x05B6) ; HEBREW POINT SEGOL
 645   (#xC7 #x05B7) ; HEBREW POINT PATAH
 646   (#xC8 #x05B8) ; HEBREW POINT QAMATS
 647   (#xC9 #x05B9) ; HEBREW POINT HOLAM
 648   (#xCA nil)
 649   (#xCB #x05BB) ; HEBREW POINT QUBUTS
 650   (#xCC #x05BC) ; HEBREW POINT DAGESH OR MAPIQ
 651   (#xCD #x05BD) ; HEBREW POINT METEG
 652   (#xCE #x05BE) ; HEBREW PUNCTUATION MAQAF
 653   (#xCF #x05BF) ; HEBREW POINT RAFE
 654   (#xD0 #x05C0) ; HEBREW PUNCTUATION PASEQ
 655   (#xD1 #x05C1) ; HEBREW POINT SHIN DOT
 656   (#xD2 #x05C2) ; HEBREW POINT SIN DOT
 657   (#xD3 #x05C3) ; HEBREW PUNCTUATION SOF PASUQ
 658   (#xD4 #x05F0) ; HEBREW LIGATURE YIDDISH DOUBLE VAV
 659   (#xD5 #x05F1) ; HEBREW LIGATURE YIDDISH VAV YOD
 660   (#xD6 #x05F2) ; HEBREW LIGATURE YIDDISH DOUBLE YOD
 661   (#xD7 #x05F3) ; HEBREW PUNCTUATION GERESH
 662   (#xD8 #x05F4) ; HEBREW PUNCTUATION GERSHAYIM
 663   (#xD9 nil)
 664   (#xDA nil)
 665   (#xDB nil)
 666   (#xDC nil)
 667   (#xDD nil)
 668   (#xDE nil)
 669   (#xDF nil)
 670   (#xE0 #x05D0) ; HEBREW LETTER ALEF
 671   (#xE1 #x05D1) ; HEBREW LETTER BET
 672   (#xE2 #x05D2) ; HEBREW LETTER GIMEL
 673   (#xE3 #x05D3) ; HEBREW LETTER DALET
 674   (#xE4 #x05D4) ; HEBREW LETTER HE
 675   (#xE5 #x05D5) ; HEBREW LETTER VAV
 676   (#xE6 #x05D6) ; HEBREW LETTER ZAYIN
 677   (#xE7 #x05D7) ; HEBREW LETTER HET
 678   (#xE8 #x05D8) ; HEBREW LETTER TET
 679   (#xE9 #x05D9) ; HEBREW LETTER YOD
 680   (#xEA #x05DA) ; HEBREW LETTER FINAL KAF
 681   (#xEB #x05DB) ; HEBREW LETTER KAF
 682   (#xEC #x05DC) ; HEBREW LETTER LAMED
 683   (#xED #x05DD) ; HEBREW LETTER FINAL MEM
 684   (#xEE #x05DE) ; HEBREW LETTER MEM
 685   (#xEF #x05DF) ; HEBREW LETTER FINAL NUN
 686   (#xF0 #x05E0) ; HEBREW LETTER NUN
 687   (#xF1 #x05E1) ; HEBREW LETTER SAMEKH
 688   (#xF2 #x05E2) ; HEBREW LETTER AYIN
 689   (#xF3 #x05E3) ; HEBREW LETTER FINAL PE
 690   (#xF4 #x05E4) ; HEBREW LETTER PE
 691   (#xF5 #x05E5) ; HEBREW LETTER FINAL TSADI
 692   (#xF6 #x05E6) ; HEBREW LETTER TSADI
 693   (#xF7 #x05E7) ; HEBREW LETTER QOF
 694   (#xF8 #x05E8) ; HEBREW LETTER RESH
 695   (#xF9 #x05E9) ; HEBREW LETTER SHIN
 696   (#xFA #x05EA) ; HEBREW LETTER TAV
 697   (#xFB nil)
 698   (#xFC nil)
 699   (#xFD #x200E) ; LEFT-TO-RIGHT MARK
 700   (#xFE #x200F) ; RIGHT-TO-LEFT MARK
 701   (#xFF nil)
 702 )
 703
 704 (declaim (inline get-cp1255-bytes))
 705 (defun get-cp1255-bytes (string pos)
 706   (declare (optimize speed (safety 0))
 707            (type simple-string string)
 708            (type array-range pos))
 709   (get-latin-bytes #'code->cp1255-mapper :cp1255 string pos))
 710
 711 (defun string->cp1255 (string sstart send null-padding)
 712   (declare (optimize speed (safety 0))
 713            (type simple-string string)
 714            (type array-range sstart send))
 715   (values (string->latin% string sstart send #'get-cp1255-bytes null-padding)))
 716
 717 (defmacro define-cp1255->string* (accessor type)
 718   (declare (ignore type))
 719   (let ((name (make-od-name 'cp1255->string* accessor)))
 720     `(progn
 721       (defun ,name (string sstart send array astart aend)
 722         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1255->code-mapper)))))
 723
 724 (instantiate-octets-definition define-cp1255->string*)
 725
 726 (defmacro define-cp1255->string (accessor type)
 727   (declare (ignore type))
 728   `(defun ,(make-od-name 'cp1255->string accessor) (array astart aend)
 729     (,(make-od-name 'latin->string accessor) array astart aend #'cp1255->code-mapper)))
 730
 731 (instantiate-octets-definition define-cp1255->string)
 732
 733 (add-external-format-funs '(:cp1255 :|cp1255| :windows-1255 :|windows-1255|)
 734                           '(cp1255->string-aref string->cp1255))
 735
 736 (define-external-format (:cp1255 :|cp1255| :windows-1255 :|windows-1255|)
 737     1 t
 738     (let ((cp1255-byte (code->cp1255-mapper bits)))
 739       (if cp1255-byte
 740           (setf (sap-ref-8 sap tail) cp1255-byte)
 741           (external-format-encoding-error stream bits)))
 742     (let ((code (cp1255->code-mapper byte)))
 743       (if code
 744           (code-char code)
 745           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 746
 747 (define-unibyte-mapper cp1256->code-mapper code->cp1256-mapper
 748   (#x80 #x20AC) ; EURO SIGN
 749   (#x81 #x067E) ; ARABIC LETTER PEH
 750   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 751   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 752   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 753   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 754   (#x86 #x2020) ; DAGGER
 755   (#x87 #x2021) ; DOUBLE DAGGER
 756   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 757   (#x89 #x2030) ; PER MILLE SIGN
 758   (#x8A nil)
 759   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 760   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 761   (#x8D #x0686) ; ARABIC LETTER TCHEH
 762   (#x8E #x0698) ; ARABIC LETTER JEH
 763   (#x8F nil)
 764   (#x90 #x06AF) ; ARABIC LETTER GAF
 765   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 766   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 767   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 768   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 769   (#x95 #x2022) ; BULLET
 770   (#x96 #x2013) ; EN DASH
 771   (#x97 #x2014) ; EM DASH
 772   (#x98 nil)
 773   (#x99 #x2122) ; TRADE MARK SIGN
 774   (#x9A nil)
 775   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 776   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 777   (#x9D #x200C) ; ZERO WIDTH NON-JOINER
 778   (#x9E #x200D) ; ZERO WIDTH JOINER
 779   (#x9F nil)
 780   (#xA1 #x060C) ; ARABIC COMMA
 781   (#xAA nil)
 782   (#xBA #x061B) ; ARABIC SEMICOLON
 783   (#xBF #x061F) ; ARABIC QUESTION MARK
 784   (#xC0 nil)
 785   (#xC1 #x0621) ; ARABIC LETTER HAMZA
 786   (#xC2 #x0622) ; ARABIC LETTER ALEF WITH MADDA ABOVE
 787   (#xC3 #x0623) ; ARABIC LETTER ALEF WITH HAMZA ABOVE
 788   (#xC4 #x0624) ; ARABIC LETTER WAW WITH HAMZA ABOVE
 789   (#xC5 #x0625) ; ARABIC LETTER ALEF WITH HAMZA BELOW
 790   (#xC6 #x0626) ; ARABIC LETTER YEH WITH HAMZA ABOVE
 791   (#xC7 #x0627) ; ARABIC LETTER ALEF
 792   (#xC8 #x0628) ; ARABIC LETTER BEH
 793   (#xC9 #x0629) ; ARABIC LETTER TEH MARBUTA
 794   (#xCA #x062A) ; ARABIC LETTER TEH
 795   (#xCB #x062B) ; ARABIC LETTER THEH
 796   (#xCC #x062C) ; ARABIC LETTER JEEM
 797   (#xCD #x062D) ; ARABIC LETTER HAH
 798   (#xCE #x062E) ; ARABIC LETTER KHAH
 799   (#xCF #x062F) ; ARABIC LETTER DAL
 800   (#xD0 #x0630) ; ARABIC LETTER THAL
 801   (#xD1 #x0631) ; ARABIC LETTER REH
 802   (#xD2 #x0632) ; ARABIC LETTER ZAIN
 803   (#xD3 #x0633) ; ARABIC LETTER SEEN
 804   (#xD4 #x0634) ; ARABIC LETTER SHEEN
 805   (#xD5 #x0635) ; ARABIC LETTER SAD
 806   (#xD6 #x0636) ; ARABIC LETTER DAD
 807   (#xD8 #x0637) ; ARABIC LETTER TAH
 808   (#xD9 #x0638) ; ARABIC LETTER ZAH
 809   (#xDA #x0639) ; ARABIC LETTER AIN
 810   (#xDB #x063A) ; ARABIC LETTER GHAIN
 811   (#xDC #x0640) ; ARABIC TATWEEL
 812   (#xDD #x0641) ; ARABIC LETTER FEH
 813   (#xDE #x0642) ; ARABIC LETTER QAF
 814   (#xDF #x0643) ; ARABIC LETTER KAF
 815   (#xE1 #x0644) ; ARABIC LETTER LAM
 816   (#xE3 #x0645) ; ARABIC LETTER MEEM
 817   (#xE4 #x0646) ; ARABIC LETTER NOON
 818   (#xE5 #x0647) ; ARABIC LETTER HEH
 819   (#xE6 #x0648) ; ARABIC LETTER WAW
 820   (#xEC #x0649) ; ARABIC LETTER ALEF MAKSURA
 821   (#xED #x064A) ; ARABIC LETTER YEH
 822   (#xF0 #x064B) ; ARABIC FATHATAN
 823   (#xF1 #x064C) ; ARABIC DAMMATAN
 824   (#xF2 #x064D) ; ARABIC KASRATAN
 825   (#xF3 #x064E) ; ARABIC FATHA
 826   (#xF5 #x064F) ; ARABIC DAMMA
 827   (#xF6 #x0650) ; ARABIC KASRA
 828   (#xF8 #x0651) ; ARABIC SHADDA
 829   (#xFA #x0652) ; ARABIC SUKUN
 830   (#xFD #x200E) ; LEFT-TO-RIGHT MARK
 831   (#xFE #x200F) ; RIGHT-TO-LEFT MARK
 832   (#xFF nil)
 833 )
 834
 835 (declaim (inline get-cp1256-bytes))
 836 (defun get-cp1256-bytes (string pos)
 837   (declare (optimize speed (safety 0))
 838            (type simple-string string)
 839            (type array-range pos))
 840   (get-latin-bytes #'code->cp1256-mapper :cp1256 string pos))
 841
 842 (defun string->cp1256 (string sstart send null-padding)
 843   (declare (optimize speed (safety 0))
 844            (type simple-string string)
 845            (type array-range sstart send))
 846   (values (string->latin% string sstart send #'get-cp1256-bytes null-padding)))
 847
 848 (defmacro define-cp1256->string* (accessor type)
 849   (declare (ignore type))
 850   (let ((name (make-od-name 'cp1256->string* accessor)))
 851     `(progn
 852       (defun ,name (string sstart send array astart aend)
 853         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1256->code-mapper)))))
 854
 855 (instantiate-octets-definition define-cp1256->string*)
 856
 857 (defmacro define-cp1256->string (accessor type)
 858   (declare (ignore type))
 859   `(defun ,(make-od-name 'cp1256->string accessor) (array astart aend)
 860     (,(make-od-name 'latin->string accessor) array astart aend #'cp1256->code-mapper)))
 861
 862 (instantiate-octets-definition define-cp1256->string)
 863
 864 (add-external-format-funs '(:cp1256 :|cp1256| :windows-1256 :|windows-1256|)
 865                           '(cp1256->string-aref string->cp1256))
 866
 867 (define-external-format (:cp1256 :|cp1256|)
 868     1 t
 869     (let ((cp1256-byte (code->cp1256-mapper bits)))
 870       (if cp1256-byte
 871           (setf (sap-ref-8 sap tail) cp1256-byte)
 872           (external-format-encoding-error stream bits)))
 873     (let ((code (cp1256->code-mapper byte)))
 874       (if code
 875           (code-char code)
 876           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 877
 878 (define-unibyte-mapper cp1257->code-mapper code->cp1257-mapper
 879   (#x80 #x20AC) ; EURO SIGN
 880   (#x81 nil)
 881   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 882   (#x83 nil)
 883   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 884   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 885   (#x86 #x2020) ; DAGGER
 886   (#x87 #x2021) ; DOUBLE DAGGER
 887   (#x88 nil)
 888   (#x89 #x2030) ; PER MILLE SIGN
 889   (#x8A nil)
 890   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 891   (#x8C nil)
 892   (#x8D #x00A8) ; DIAERESIS
 893   (#x8E #x02C7) ; CARON
 894   (#x8F #x00B8) ; CEDILLA
 895   (#x90 nil)
 896   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 897   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 898   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 899   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 900   (#x95 #x2022) ; BULLET
 901   (#x96 #x2013) ; EN DASH
 902   (#x97 #x2014) ; EM DASH
 903   (#x98 nil)
 904   (#x99 #x2122) ; TRADE MARK SIGN
 905   (#x9A nil)
 906   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 907   (#x9C nil)
 908   (#x9D #x00AF) ; MACRON
 909   (#x9E #x02DB) ; OGONEK
 910   (#x9F nil)
 911   (#xA1 nil)
 912   (#xA5 nil)
 913   (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
 914   (#xAA #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
 915   (#xAF #x00C6) ; LATIN CAPITAL LETTER AE
 916   (#xB8 #x00F8) ; LATIN SMALL LETTER O WITH STROKE
 917   (#xBA #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
 918   (#xBF #x00E6) ; LATIN SMALL LETTER AE
 919   (#xC0 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 920   (#xC1 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 921   (#xC2 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 922   (#xC3 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
 923   (#xC6 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 924   (#xC7 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 925   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 926   (#xCA #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
 927   (#xCB #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 928   (#xCC #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 929   (#xCD #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 930   (#xCE #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 931   (#xCF #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 932   (#xD0 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 933   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
 934   (#xD2 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 935   (#xD4 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 936   (#xD8 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 937   (#xD9 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
 938   (#xDA #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
 939   (#xDB #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 940   (#xDD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
 941   (#xDE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 942   (#xE0 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 943   (#xE1 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 944   (#xE2 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 945   (#xE3 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
 946   (#xE6 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 947   (#xE7 #x0113) ; LATIN SMALL LETTER E WITH MACRON
 948   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 949   (#xEA #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
 950   (#xEB #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 951   (#xEC #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 952   (#xED #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 953   (#xEE #x012B) ; LATIN SMALL LETTER I WITH MACRON
 954   (#xEF #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 955   (#xF0 #x0161) ; LATIN SMALL LETTER S WITH CARON
 956   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
 957   (#xF2 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 958   (#xF4 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 959   (#xF8 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 960   (#xF9 #x0142) ; LATIN SMALL LETTER L WITH STROKE
 961   (#xFA #x015B) ; LATIN SMALL LETTER S WITH ACUTE
 962   (#xFB #x016B) ; LATIN SMALL LETTER U WITH MACRON
 963   (#xFD #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
 964   (#xFE #x017E) ; LATIN SMALL LETTER Z WITH CARON
 965   (#xFF #x02D9) ; DOT ABOVE
 966 )
 967
 968 (declaim (inline get-cp1257-bytes))
 969 (defun get-cp1257-bytes (string pos)
 970   (declare (optimize speed (safety 0))
 971            (type simple-string string)
 972            (type array-range pos))
 973   (get-latin-bytes #'code->cp1257-mapper :cp1257 string pos))
 974
 975 (defun string->cp1257 (string sstart send null-padding)
 976   (declare (optimize speed (safety 0))
 977            (type simple-string string)
 978            (type array-range sstart send))
 979   (values (string->latin% string sstart send #'get-cp1257-bytes null-padding)))
 980
 981 (defmacro define-cp1257->string* (accessor type)
 982   (declare (ignore type))
 983   (let ((name (make-od-name 'cp1257->string* accessor)))
 984     `(progn
 985       (defun ,name (string sstart send array astart aend)
 986         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1257->code-mapper)))))
 987
 988 (instantiate-octets-definition define-cp1257->string*)
 989
 990 (defmacro define-cp1257->string (accessor type)
 991   (declare (ignore type))
 992   `(defun ,(make-od-name 'cp1257->string accessor) (array astart aend)
 993     (,(make-od-name 'latin->string accessor) array astart aend #'cp1257->code-mapper)))
 994
 995 (instantiate-octets-definition define-cp1257->string)
 996
 997 (add-external-format-funs '(:cp1257 :|cp1257| :windows-1257 :|windows-1257|)
 998                           '(cp1257->string-aref string->cp1257))
 999
1000 (define-external-format (:cp1257 :|cp1257| :windows-1257 :|windows-1257|)
1001     1 t
1002     (let ((cp1257-byte (code->cp1257-mapper bits)))
1003       (if cp1257-byte
1004           (setf (sap-ref-8 sap tail) cp1257-byte)
1005           (external-format-encoding-error stream bits)))
1006     (let ((code (cp1257->code-mapper byte)))
1007       (if code
1008           (code-char code)
1009           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1010
1011 (define-unibyte-mapper cp1258->code-mapper code->cp1258-mapper
1012   (#x80 #x20AC) ; EURO SIGN
1013   (#x81 nil)
1014   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
1015   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
1016   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
1017   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
1018   (#x86 #x2020) ; DAGGER
1019   (#x87 #x2021) ; DOUBLE DAGGER
1020   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
1021   (#x89 #x2030) ; PER MILLE SIGN
1022   (#x8A nil)
1023   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1024   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
1025   (#x8D nil)
1026   (#x8E nil)
1027   (#x8F nil)
1028   (#x90 nil)
1029   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
1030   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
1031   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
1032   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
1033   (#x95 #x2022) ; BULLET
1034   (#x96 #x2013) ; EN DASH
1035   (#x97 #x2014) ; EM DASH
1036   (#x98 #x02DC) ; SMALL TILDE
1037   (#x99 #x2122) ; TRADE MARK SIGN
1038   (#x9A nil)
1039   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1040   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
1041   (#x9D nil)
1042   (#x9E nil)
1043   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
1044   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
1045   (#xCC #x0300) ; COMBINING GRAVE ACCENT
1046   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
1047   (#xD2 #x0309) ; COMBINING HOOK ABOVE
1048   (#xD5 #x01A0) ; LATIN CAPITAL LETTER O WITH HORN
1049   (#xDD #x01AF) ; LATIN CAPITAL LETTER U WITH HORN
1050   (#xDE #x0303) ; COMBINING TILDE
1051   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
1052   (#xEC #x0301) ; COMBINING ACUTE ACCENT
1053   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
1054   (#xF2 #x0323) ; COMBINING DOT BELOW
1055   (#xF5 #x01A1) ; LATIN SMALL LETTER O WITH HORN
1056   (#xFD #x01B0) ; LATIN SMALL LETTER U WITH HORN
1057   (#xFE #x20AB) ; DONG SIGN
1058 )
1059
1060 (declaim (inline get-cp1258-bytes))
1061 (defun get-cp1258-bytes (string pos)
1062   (declare (optimize speed (safety 0))
1063            (type simple-string string)
1064            (type array-range pos))
1065   (get-latin-bytes #'code->cp1258-mapper :cp1258 string pos))
1066
1067 (defun string->cp1258 (string sstart send null-padding)
1068   (declare (optimize speed (safety 0))
1069            (type simple-string string)
1070            (type array-range sstart send))
1071   (values (string->latin% string sstart send #'get-cp1258-bytes null-padding)))
1072
1073 (defmacro define-cp1258->string* (accessor type)
1074   (declare (ignore type))
1075   (let ((name (make-od-name 'cp1258->string* accessor)))
1076     `(progn
1077       (defun ,name (string sstart send array astart aend)
1078         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1258->code-mapper)))))
1079
1080 (instantiate-octets-definition define-cp1258->string*)
1081
1082 (defmacro define-cp1258->string (accessor type)
1083   (declare (ignore type))
1084   `(defun ,(make-od-name 'cp1258->string accessor) (array astart aend)
1085     (,(make-od-name 'latin->string accessor) array astart aend #'cp1258->code-mapper)))
1086
1087 (instantiate-octets-definition define-cp1258->string)
1088
1089 (add-external-format-funs '(:cp1258 :|cp1258| :windows-1258 :|windows-1258|)
1090                           '(cp1258->string-aref string->cp1258))
1091
1092 (define-external-format (:cp1258 :|cp1258| :windows-1258 :|windows-1258|)
1093     1 t
1094     (let ((cp1258-byte (code->cp1258-mapper bits)))
1095       (if cp1258-byte
1096           (setf (sap-ref-8 sap tail) cp1258-byte)
1097           (external-format-encoding-error stream bits)))
1098     (let ((code (cp1258->code-mapper byte)))
1099       (if code
1100           (code-char code)
1101           (external-format-decoding-error stream byte)))) ;; TODO -- error check