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