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

   1 (in-package "SB!IMPL")
   2
   3 (define-unibyte-mapper iso-8859-2->code-mapper code->iso-8859-2-mapper
   4   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
   5   (#xA2 #x02D8) ; BREVE
   6   (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
   7   (#xA5 #x013D) ; LATIN CAPITAL LETTER L WITH CARON
   8   (#xA6 #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
   9   (#xA9 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  10   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
  11   (#xAB #x0164) ; LATIN CAPITAL LETTER T WITH CARON
  12   (#xAC #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
  13   (#xAE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
  14   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
  15   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
  16   (#xB2 #x02DB) ; OGONEK
  17   (#xB3 #x0142) ; LATIN SMALL LETTER L WITH STROKE
  18   (#xB5 #x013E) ; LATIN SMALL LETTER L WITH CARON
  19   (#xB6 #x015B) ; LATIN SMALL LETTER S WITH ACUTE
  20   (#xB7 #x02C7) ; CARON
  21   (#xB9 #x0161) ; LATIN SMALL LETTER S WITH CARON
  22   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
  23   (#xBB #x0165) ; LATIN SMALL LETTER T WITH CARON
  24   (#xBC #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
  25   (#xBD #x02DD) ; DOUBLE ACUTE ACCENT
  26   (#xBE #x017E) ; LATIN SMALL LETTER Z WITH CARON
  27   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
  28   (#xC0 #x0154) ; LATIN CAPITAL LETTER R WITH ACUTE
  29   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
  30   (#xC5 #x0139) ; LATIN CAPITAL LETTER L WITH ACUTE
  31   (#xC6 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
  32   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
  33   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
  34   (#xCC #x011A) ; LATIN CAPITAL LETTER E WITH CARON
  35   (#xCF #x010E) ; LATIN CAPITAL LETTER D WITH CARON
  36   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
  37   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
  38   (#xD2 #x0147) ; LATIN CAPITAL LETTER N WITH CARON
  39   (#xD5 #x0150) ; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
  40   (#xD8 #x0158) ; LATIN CAPITAL LETTER R WITH CARON
  41   (#xD9 #x016E) ; LATIN CAPITAL LETTER U WITH RING ABOVE
  42   (#xDB #x0170) ; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
  43   (#xDE #x0162) ; LATIN CAPITAL LETTER T WITH CEDILLA
  44   (#xE0 #x0155) ; LATIN SMALL LETTER R WITH ACUTE
  45   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
  46   (#xE5 #x013A) ; LATIN SMALL LETTER L WITH ACUTE
  47   (#xE6 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
  48   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
  49   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
  50   (#xEC #x011B) ; LATIN SMALL LETTER E WITH CARON
  51   (#xEF #x010F) ; LATIN SMALL LETTER D WITH CARON
  52   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
  53   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
  54   (#xF2 #x0148) ; LATIN SMALL LETTER N WITH CARON
  55   (#xF5 #x0151) ; LATIN SMALL LETTER O WITH DOUBLE ACUTE
  56   (#xF8 #x0159) ; LATIN SMALL LETTER R WITH CARON
  57   (#xF9 #x016F) ; LATIN SMALL LETTER U WITH RING ABOVE
  58   (#xFB #x0171) ; LATIN SMALL LETTER U WITH DOUBLE ACUTE
  59   (#xFE #x0163) ; LATIN SMALL LETTER T WITH CEDILLA
  60   (#xFF #x02D9) ; DOT ABOVE
  61 )
  62
  63 (declaim (inline get-iso-8859-2-bytes))
  64 (defun get-iso-8859-2-bytes (string pos)
  65   (declare (optimize speed (safety 0))
  66            (type simple-string string)
  67            (type array-range pos))
  68   (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos))
  69
  70 (defun string->iso-8859-2 (string sstart send null-padding)
  71   (declare (optimize speed (safety 0))
  72            (type simple-string string)
  73            (type array-range sstart send))
  74   (values (string->latin% string sstart send #'get-iso-8859-2-bytes null-padding)))
  75
  76 (defmacro define-iso-8859-2->string* (accessor type)
  77   (declare (ignore type))
  78   (let ((name (make-od-name 'iso-8859-2->string* accessor)))
  79     `(progn
  80       (defun ,name (string sstart send array astart aend)
  81         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-2->code-mapper)))))
  82
  83 (instantiate-octets-definition define-iso-8859-2->string*)
  84
  85 (defmacro define-iso-8859-2->string (accessor type)
  86   (declare (ignore type))
  87   `(defun ,(make-od-name 'iso-8859-2->string accessor) (array astart aend)
  88     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-2->code-mapper)))
  89
  90 (instantiate-octets-definition define-iso-8859-2->string)
  91
  92 (add-external-format-funs '(:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|)
  93                           '(iso-8859-2->string-aref string->iso-8859-2))
  94
  95 (define-external-format (:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|)
  96     1 t
  97     (let ((iso-8859-2-byte (code->iso-8859-2-mapper bits)))
  98       (if iso-8859-2-byte
  99           (setf (sap-ref-8 sap tail) iso-8859-2-byte)
 100           (external-format-encoding-error stream bits)))
 101     (let ((code (iso-8859-2->code-mapper byte)))
 102       (if code
 103           (code-char code)
 104           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 105
 106 (define-unibyte-mapper iso-8859-3->code-mapper code->iso-8859-3-mapper
 107   (#xA1 #x0126) ; LATIN CAPITAL LETTER H WITH STROKE
 108   (#xA2 #x02D8) ; BREVE
 109   (#xA5 nil)
 110   (#xA6 #x0124) ; LATIN CAPITAL LETTER H WITH CIRCUMFLEX
 111   (#xA9 #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 112   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 113   (#xAB #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 114   (#xAC #x0134) ; LATIN CAPITAL LETTER J WITH CIRCUMFLEX
 115   (#xAE nil)
 116   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
 117   (#xB1 #x0127) ; LATIN SMALL LETTER H WITH STROKE
 118   (#xB6 #x0125) ; LATIN SMALL LETTER H WITH CIRCUMFLEX
 119   (#xB9 #x0131) ; LATIN SMALL LETTER DOTLESS I
 120   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 121   (#xBB #x011F) ; LATIN SMALL LETTER G WITH BREVE
 122   (#xBC #x0135) ; LATIN SMALL LETTER J WITH CIRCUMFLEX
 123   (#xBE nil)
 124   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
 125   (#xC3 nil)
 126   (#xC5 #x010A) ; LATIN CAPITAL LETTER C WITH DOT ABOVE
 127   (#xC6 #x0108) ; LATIN CAPITAL LETTER C WITH CIRCUMFLEX
 128   (#xD0 nil)
 129   (#xD5 #x0120) ; LATIN CAPITAL LETTER G WITH DOT ABOVE
 130   (#xD8 #x011C) ; LATIN CAPITAL LETTER G WITH CIRCUMFLEX
 131   (#xDD #x016C) ; LATIN CAPITAL LETTER U WITH BREVE
 132   (#xDE #x015C) ; LATIN CAPITAL LETTER S WITH CIRCUMFLEX
 133   (#xE3 nil)
 134   (#xE5 #x010B) ; LATIN SMALL LETTER C WITH DOT ABOVE
 135   (#xE6 #x0109) ; LATIN SMALL LETTER C WITH CIRCUMFLEX
 136   (#xF0 nil)
 137   (#xF5 #x0121) ; LATIN SMALL LETTER G WITH DOT ABOVE
 138   (#xF8 #x011D) ; LATIN SMALL LETTER G WITH CIRCUMFLEX
 139   (#xFD #x016D) ; LATIN SMALL LETTER U WITH BREVE
 140   (#xFE #x015D) ; LATIN SMALL LETTER S WITH CIRCUMFLEX
 141   (#xFF #x02D9) ; DOT ABOVE
 142 )
 143
 144 (declaim (inline get-iso-8859-3-bytes))
 145 (defun get-iso-8859-3-bytes (string pos)
 146   (declare (optimize speed (safety 0))
 147            (type simple-string string)
 148            (type array-range pos))
 149   (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos))
 150
 151 (defun string->iso-8859-3 (string sstart send null-padding)
 152   (declare (optimize speed (safety 0))
 153            (type simple-string string)
 154            (type array-range sstart send))
 155   (values (string->latin% string sstart send #'get-iso-8859-3-bytes null-padding)))
 156
 157 (defmacro define-iso-8859-3->string* (accessor type)
 158   (declare (ignore type))
 159   (let ((name (make-od-name 'iso-8859-3->string* accessor)))
 160     `(progn
 161       (defun ,name (string sstart send array astart aend)
 162         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-3->code-mapper)))))
 163
 164 (instantiate-octets-definition define-iso-8859-3->string*)
 165
 166 (defmacro define-iso-8859-3->string (accessor type)
 167   (declare (ignore type))
 168   `(defun ,(make-od-name 'iso-8859-3->string accessor) (array astart aend)
 169     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-3->code-mapper)))
 170
 171 (instantiate-octets-definition define-iso-8859-3->string)
 172
 173 (add-external-format-funs '(:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|)
 174                           '(iso-8859-3->string-aref string->iso-8859-3))
 175
 176 (define-external-format (:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|)
 177     1 t
 178     (let ((iso-8859-3-byte (code->iso-8859-3-mapper bits)))
 179       (if iso-8859-3-byte
 180           (setf (sap-ref-8 sap tail) iso-8859-3-byte)
 181           (external-format-encoding-error stream bits)))
 182     (let ((code (iso-8859-3->code-mapper byte)))
 183       (if code
 184           (code-char code)
 185           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 186
 187 (define-unibyte-mapper iso-8859-4->code-mapper code->iso-8859-4-mapper
 188   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 189   (#xA2 #x0138) ; LATIN SMALL LETTER KRA
 190   (#xA3 #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
 191   (#xA5 #x0128) ; LATIN CAPITAL LETTER I WITH TILDE
 192   (#xA6 #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 193   (#xA9 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 194   (#xAA #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 195   (#xAB #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 196   (#xAC #x0166) ; LATIN CAPITAL LETTER T WITH STROKE
 197   (#xAE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 198   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 199   (#xB2 #x02DB) ; OGONEK
 200   (#xB3 #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
 201   (#xB5 #x0129) ; LATIN SMALL LETTER I WITH TILDE
 202   (#xB6 #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 203   (#xB7 #x02C7) ; CARON
 204   (#xB9 #x0161) ; LATIN SMALL LETTER S WITH CARON
 205   (#xBA #x0113) ; LATIN SMALL LETTER E WITH MACRON
 206   (#xBB #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 207   (#xBC #x0167) ; LATIN SMALL LETTER T WITH STROKE
 208   (#xBD #x014A) ; LATIN CAPITAL LETTER ENG
 209   (#xBE #x017E) ; LATIN SMALL LETTER Z WITH CARON
 210   (#xBF #x014B) ; LATIN SMALL LETTER ENG
 211   (#xC0 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 212   (#xC7 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 213   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 214   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 215   (#xCC #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 216   (#xCF #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 217   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
 218   (#xD1 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 219   (#xD2 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 220   (#xD3 #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 221   (#xD9 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 222   (#xDD #x0168) ; LATIN CAPITAL LETTER U WITH TILDE
 223   (#xDE #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 224   (#xE0 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 225   (#xE7 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 226   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 227   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 228   (#xEC #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 229   (#xEF #x012B) ; LATIN SMALL LETTER I WITH MACRON
 230   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
 231   (#xF1 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 232   (#xF2 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 233   (#xF3 #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 234   (#xF9 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 235   (#xFD #x0169) ; LATIN SMALL LETTER U WITH TILDE
 236   (#xFE #x016B) ; LATIN SMALL LETTER U WITH MACRON
 237   (#xFF #x02D9) ; DOT ABOVE
 238 )
 239
 240 (declaim (inline get-iso-8859-4-bytes))
 241 (defun get-iso-8859-4-bytes (string pos)
 242   (declare (optimize speed (safety 0))
 243            (type simple-string string)
 244            (type array-range pos))
 245   (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos))
 246
 247 (defun string->iso-8859-4 (string sstart send null-padding)
 248   (declare (optimize speed (safety 0))
 249            (type simple-string string)
 250            (type array-range sstart send))
 251   (values (string->latin% string sstart send #'get-iso-8859-4-bytes null-padding)))
 252
 253 (defmacro define-iso-8859-4->string* (accessor type)
 254   (declare (ignore type))
 255   (let ((name (make-od-name 'iso-8859-4->string* accessor)))
 256     `(progn
 257       (defun ,name (string sstart send array astart aend)
 258         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-4->code-mapper)))))
 259
 260 (instantiate-octets-definition define-iso-8859-4->string*)
 261
 262 (defmacro define-iso-8859-4->string (accessor type)
 263   (declare (ignore type))
 264   `(defun ,(make-od-name 'iso-8859-4->string accessor) (array astart aend)
 265     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-4->code-mapper)))
 266
 267 (instantiate-octets-definition define-iso-8859-4->string)
 268
 269 (add-external-format-funs '(:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|)
 270                           '(iso-8859-4->string-aref string->iso-8859-4))
 271
 272 (define-external-format (:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|)
 273     1 t
 274     (let ((iso-8859-4-byte (code->iso-8859-4-mapper bits)))
 275       (if iso-8859-4-byte
 276           (setf (sap-ref-8 sap tail) iso-8859-4-byte)
 277           (external-format-encoding-error stream bits)))
 278     (let ((code (iso-8859-4->code-mapper byte)))
 279       (if code
 280           (code-char code)
 281           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 282
 283 (define-unibyte-mapper iso-8859-5->code-mapper code->iso-8859-5-mapper
 284   (#xA1 #x0401) ; CYRILLIC CAPITAL LETTER IO
 285   (#xA2 #x0402) ; CYRILLIC CAPITAL LETTER DJE
 286   (#xA3 #x0403) ; CYRILLIC CAPITAL LETTER GJE
 287   (#xA4 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 288   (#xA5 #x0405) ; CYRILLIC CAPITAL LETTER DZE
 289   (#xA6 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 290   (#xA7 #x0407) ; CYRILLIC CAPITAL LETTER YI
 291   (#xA8 #x0408) ; CYRILLIC CAPITAL LETTER JE
 292   (#xA9 #x0409) ; CYRILLIC CAPITAL LETTER LJE
 293   (#xAA #x040A) ; CYRILLIC CAPITAL LETTER NJE
 294   (#xAB #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 295   (#xAC #x040C) ; CYRILLIC CAPITAL LETTER KJE
 296   (#xAE #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 297   (#xAF #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 298   (#xB0 #x0410) ; CYRILLIC CAPITAL LETTER A
 299   (#xB1 #x0411) ; CYRILLIC CAPITAL LETTER BE
 300   (#xB2 #x0412) ; CYRILLIC CAPITAL LETTER VE
 301   (#xB3 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 302   (#xB4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 303   (#xB5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 304   (#xB6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 305   (#xB7 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 306   (#xB8 #x0418) ; CYRILLIC CAPITAL LETTER I
 307   (#xB9 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 308   (#xBA #x041A) ; CYRILLIC CAPITAL LETTER KA
 309   (#xBB #x041B) ; CYRILLIC CAPITAL LETTER EL
 310   (#xBC #x041C) ; CYRILLIC CAPITAL LETTER EM
 311   (#xBD #x041D) ; CYRILLIC CAPITAL LETTER EN
 312   (#xBE #x041E) ; CYRILLIC CAPITAL LETTER O
 313   (#xBF #x041F) ; CYRILLIC CAPITAL LETTER PE
 314   (#xC0 #x0420) ; CYRILLIC CAPITAL LETTER ER
 315   (#xC1 #x0421) ; CYRILLIC CAPITAL LETTER ES
 316   (#xC2 #x0422) ; CYRILLIC CAPITAL LETTER TE
 317   (#xC3 #x0423) ; CYRILLIC CAPITAL LETTER U
 318   (#xC4 #x0424) ; CYRILLIC CAPITAL LETTER EF
 319   (#xC5 #x0425) ; CYRILLIC CAPITAL LETTER HA
 320   (#xC6 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 321   (#xC7 #x0427) ; CYRILLIC CAPITAL LETTER CHE
 322   (#xC8 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 323   (#xC9 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 324   (#xCA #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 325   (#xCB #x042B) ; CYRILLIC CAPITAL LETTER YERU
 326   (#xCC #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 327   (#xCD #x042D) ; CYRILLIC CAPITAL LETTER E
 328   (#xCE #x042E) ; CYRILLIC CAPITAL LETTER YU
 329   (#xCF #x042F) ; CYRILLIC CAPITAL LETTER YA
 330   (#xD0 #x0430) ; CYRILLIC SMALL LETTER A
 331   (#xD1 #x0431) ; CYRILLIC SMALL LETTER BE
 332   (#xD2 #x0432) ; CYRILLIC SMALL LETTER VE
 333   (#xD3 #x0433) ; CYRILLIC SMALL LETTER GHE
 334   (#xD4 #x0434) ; CYRILLIC SMALL LETTER DE
 335   (#xD5 #x0435) ; CYRILLIC SMALL LETTER IE
 336   (#xD6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 337   (#xD7 #x0437) ; CYRILLIC SMALL LETTER ZE
 338   (#xD8 #x0438) ; CYRILLIC SMALL LETTER I
 339   (#xD9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
 340   (#xDA #x043A) ; CYRILLIC SMALL LETTER KA
 341   (#xDB #x043B) ; CYRILLIC SMALL LETTER EL
 342   (#xDC #x043C) ; CYRILLIC SMALL LETTER EM
 343   (#xDD #x043D) ; CYRILLIC SMALL LETTER EN
 344   (#xDE #x043E) ; CYRILLIC SMALL LETTER O
 345   (#xDF #x043F) ; CYRILLIC SMALL LETTER PE
 346   (#xE0 #x0440) ; CYRILLIC SMALL LETTER ER
 347   (#xE1 #x0441) ; CYRILLIC SMALL LETTER ES
 348   (#xE2 #x0442) ; CYRILLIC SMALL LETTER TE
 349   (#xE3 #x0443) ; CYRILLIC SMALL LETTER U
 350   (#xE4 #x0444) ; CYRILLIC SMALL LETTER EF
 351   (#xE5 #x0445) ; CYRILLIC SMALL LETTER HA
 352   (#xE6 #x0446) ; CYRILLIC SMALL LETTER TSE
 353   (#xE7 #x0447) ; CYRILLIC SMALL LETTER CHE
 354   (#xE8 #x0448) ; CYRILLIC SMALL LETTER SHA
 355   (#xE9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 356   (#xEA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 357   (#xEB #x044B) ; CYRILLIC SMALL LETTER YERU
 358   (#xEC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 359   (#xED #x044D) ; CYRILLIC SMALL LETTER E
 360   (#xEE #x044E) ; CYRILLIC SMALL LETTER YU
 361   (#xEF #x044F) ; CYRILLIC SMALL LETTER YA
 362   (#xF0 #x2116) ; NUMERO SIGN
 363   (#xF1 #x0451) ; CYRILLIC SMALL LETTER IO
 364   (#xF2 #x0452) ; CYRILLIC SMALL LETTER DJE
 365   (#xF3 #x0453) ; CYRILLIC SMALL LETTER GJE
 366   (#xF4 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 367   (#xF5 #x0455) ; CYRILLIC SMALL LETTER DZE
 368   (#xF6 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 369   (#xF7 #x0457) ; CYRILLIC SMALL LETTER YI
 370   (#xF8 #x0458) ; CYRILLIC SMALL LETTER JE
 371   (#xF9 #x0459) ; CYRILLIC SMALL LETTER LJE
 372   (#xFA #x045A) ; CYRILLIC SMALL LETTER NJE
 373   (#xFB #x045B) ; CYRILLIC SMALL LETTER TSHE
 374   (#xFC #x045C) ; CYRILLIC SMALL LETTER KJE
 375   (#xFD #x00A7) ; SECTION SIGN
 376   (#xFE #x045E) ; CYRILLIC SMALL LETTER SHORT U
 377   (#xFF #x045F) ; CYRILLIC SMALL LETTER DZHE
 378 )
 379
 380 (declaim (inline get-iso-8859-5-bytes))
 381 (defun get-iso-8859-5-bytes (string pos)
 382   (declare (optimize speed (safety 0))
 383            (type simple-string string)
 384            (type array-range pos))
 385   (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos))
 386
 387 (defun string->iso-8859-5 (string sstart send null-padding)
 388   (declare (optimize speed (safety 0))
 389            (type simple-string string)
 390            (type array-range sstart send))
 391   (values (string->latin% string sstart send #'get-iso-8859-5-bytes null-padding)))
 392
 393 (defmacro define-iso-8859-5->string* (accessor type)
 394   (declare (ignore type))
 395   (let ((name (make-od-name 'iso-8859-5->string* accessor)))
 396     `(progn
 397       (defun ,name (string sstart send array astart aend)
 398         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-5->code-mapper)))))
 399
 400 (instantiate-octets-definition define-iso-8859-5->string*)
 401
 402 (defmacro define-iso-8859-5->string (accessor type)
 403   (declare (ignore type))
 404   `(defun ,(make-od-name 'iso-8859-5->string accessor) (array astart aend)
 405     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-5->code-mapper)))
 406
 407 (instantiate-octets-definition define-iso-8859-5->string)
 408
 409 (add-external-format-funs '(:iso-8859-5 :|iso-8859-5|)
 410                           '(iso-8859-5->string-aref string->iso-8859-5))
 411
 412 (define-external-format (:iso-8859-5 :|iso-8859-5|)
 413     1 t
 414     (let ((iso-8859-5-byte (code->iso-8859-5-mapper bits)))
 415       (if iso-8859-5-byte
 416           (setf (sap-ref-8 sap tail) iso-8859-5-byte)
 417           (external-format-encoding-error stream bits)))
 418     (let ((code (iso-8859-5->code-mapper byte)))
 419       (if code
 420           (code-char code)
 421           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 422
 423 (define-unibyte-mapper iso-8859-6->code-mapper code->iso-8859-6-mapper
 424   (#xA1 nil)
 425   (#xA2 nil)
 426   (#xA3 nil)
 427   (#xA5 nil)
 428   (#xA6 nil)
 429   (#xA7 nil)
 430   (#xA8 nil)
 431   (#xA9 nil)
 432   (#xAA nil)
 433   (#xAB nil)
 434   (#xAC #x060C) ; ARABIC COMMA
 435   (#xAE nil)
 436   (#xAF nil)
 437   (#xB0 nil)
 438   (#xB1 nil)
 439   (#xB2 nil)
 440   (#xB3 nil)
 441   (#xB4 nil)
 442   (#xB5 nil)
 443   (#xB6 nil)
 444   (#xB7 nil)
 445   (#xB8 nil)
 446   (#xB9 nil)
 447   (#xBA nil)
 448   (#xBB #x061B) ; ARABIC SEMICOLON
 449   (#xBC nil)
 450   (#xBD nil)
 451   (#xBE nil)
 452   (#xBF #x061F) ; ARABIC QUESTION MARK
 453   (#xC0 nil)
 454   (#xC1 #x0621) ; ARABIC LETTER HAMZA
 455   (#xC2 #x0622) ; ARABIC LETTER ALEF WITH MADDA ABOVE
 456   (#xC3 #x0623) ; ARABIC LETTER ALEF WITH HAMZA ABOVE
 457   (#xC4 #x0624) ; ARABIC LETTER WAW WITH HAMZA ABOVE
 458   (#xC5 #x0625) ; ARABIC LETTER ALEF WITH HAMZA BELOW
 459   (#xC6 #x0626) ; ARABIC LETTER YEH WITH HAMZA ABOVE
 460   (#xC7 #x0627) ; ARABIC LETTER ALEF
 461   (#xC8 #x0628) ; ARABIC LETTER BEH
 462   (#xC9 #x0629) ; ARABIC LETTER TEH MARBUTA
 463   (#xCA #x062A) ; ARABIC LETTER TEH
 464   (#xCB #x062B) ; ARABIC LETTER THEH
 465   (#xCC #x062C) ; ARABIC LETTER JEEM
 466   (#xCD #x062D) ; ARABIC LETTER HAH
 467   (#xCE #x062E) ; ARABIC LETTER KHAH
 468   (#xCF #x062F) ; ARABIC LETTER DAL
 469   (#xD0 #x0630) ; ARABIC LETTER THAL
 470   (#xD1 #x0631) ; ARABIC LETTER REH
 471   (#xD2 #x0632) ; ARABIC LETTER ZAIN
 472   (#xD3 #x0633) ; ARABIC LETTER SEEN
 473   (#xD4 #x0634) ; ARABIC LETTER SHEEN
 474   (#xD5 #x0635) ; ARABIC LETTER SAD
 475   (#xD6 #x0636) ; ARABIC LETTER DAD
 476   (#xD7 #x0637) ; ARABIC LETTER TAH
 477   (#xD8 #x0638) ; ARABIC LETTER ZAH
 478   (#xD9 #x0639) ; ARABIC LETTER AIN
 479   (#xDA #x063A) ; ARABIC LETTER GHAIN
 480   (#xDB nil)
 481   (#xDC nil)
 482   (#xDD nil)
 483   (#xDE nil)
 484   (#xDF nil)
 485   (#xE0 #x0640) ; ARABIC TATWEEL
 486   (#xE1 #x0641) ; ARABIC LETTER FEH
 487   (#xE2 #x0642) ; ARABIC LETTER QAF
 488   (#xE3 #x0643) ; ARABIC LETTER KAF
 489   (#xE4 #x0644) ; ARABIC LETTER LAM
 490   (#xE5 #x0645) ; ARABIC LETTER MEEM
 491   (#xE6 #x0646) ; ARABIC LETTER NOON
 492   (#xE7 #x0647) ; ARABIC LETTER HEH
 493   (#xE8 #x0648) ; ARABIC LETTER WAW
 494   (#xE9 #x0649) ; ARABIC LETTER ALEF MAKSURA
 495   (#xEA #x064A) ; ARABIC LETTER YEH
 496   (#xEB #x064B) ; ARABIC FATHATAN
 497   (#xEC #x064C) ; ARABIC DAMMATAN
 498   (#xED #x064D) ; ARABIC KASRATAN
 499   (#xEE #x064E) ; ARABIC FATHA
 500   (#xEF #x064F) ; ARABIC DAMMA
 501   (#xF0 #x0650) ; ARABIC KASRA
 502   (#xF1 #x0651) ; ARABIC SHADDA
 503   (#xF2 #x0652) ; ARABIC SUKUN
 504   (#xF3 nil)
 505   (#xF4 nil)
 506   (#xF5 nil)
 507   (#xF6 nil)
 508   (#xF7 nil)
 509   (#xF8 nil)
 510   (#xF9 nil)
 511   (#xFA nil)
 512   (#xFB nil)
 513   (#xFC nil)
 514   (#xFD nil)
 515   (#xFE nil)
 516   (#xFF nil)
 517 )
 518
 519 (declaim (inline get-iso-8859-6-bytes))
 520 (defun get-iso-8859-6-bytes (string pos)
 521   (declare (optimize speed (safety 0))
 522            (type simple-string string)
 523            (type array-range pos))
 524   (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos))
 525
 526 (defun string->iso-8859-6 (string sstart send null-padding)
 527   (declare (optimize speed (safety 0))
 528            (type simple-string string)
 529            (type array-range sstart send))
 530   (values (string->latin% string sstart send #'get-iso-8859-6-bytes null-padding)))
 531
 532 (defmacro define-iso-8859-6->string* (accessor type)
 533   (declare (ignore type))
 534   (let ((name (make-od-name 'iso-8859-6->string* accessor)))
 535     `(progn
 536       (defun ,name (string sstart send array astart aend)
 537         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-6->code-mapper)))))
 538
 539 (instantiate-octets-definition define-iso-8859-6->string*)
 540
 541 (defmacro define-iso-8859-6->string (accessor type)
 542   (declare (ignore type))
 543   `(defun ,(make-od-name 'iso-8859-6->string accessor) (array astart aend)
 544     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-6->code-mapper)))
 545
 546 (instantiate-octets-definition define-iso-8859-6->string)
 547
 548 (add-external-format-funs '(:iso-8859-6 :|iso-8859-6|)
 549                           '(iso-8859-6->string-aref string->iso-8859-6))
 550
 551 (define-external-format (:iso-8859-6 :|iso-8859-6|)
 552     1 t
 553     (let ((iso-8859-6-byte (code->iso-8859-6-mapper bits)))
 554       (if iso-8859-6-byte
 555           (setf (sap-ref-8 sap tail) iso-8859-6-byte)
 556           (external-format-encoding-error stream bits)))
 557     (let ((code (iso-8859-6->code-mapper byte)))
 558       (if code
 559           (code-char code)
 560           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 561
 562 (define-unibyte-mapper iso-8859-7->code-mapper code->iso-8859-7-mapper
 563   (#xA1 #x02BD) ; MODIFIER LETTER REVERSED COMMA
 564   (#xA2 #x02BC) ; MODIFIER LETTER APOSTROPHE
 565   (#xA4 nil)
 566   (#xA5 nil)
 567   (#xAA nil)
 568   (#xAE nil)
 569   (#xAF #x2015) ; HORIZONTAL BAR
 570   (#xB4 #x0384) ; GREEK TONOS
 571   (#xB5 #x0385) ; GREEK DIALYTIKA TONOS
 572   (#xB6 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
 573   (#xB8 #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
 574   (#xB9 #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
 575   (#xBA #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
 576   (#xBC #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
 577   (#xBE #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
 578   (#xBF #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
 579   (#xC0 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
 580   (#xC1 #x0391) ; GREEK CAPITAL LETTER ALPHA
 581   (#xC2 #x0392) ; GREEK CAPITAL LETTER BETA
 582   (#xC3 #x0393) ; GREEK CAPITAL LETTER GAMMA
 583   (#xC4 #x0394) ; GREEK CAPITAL LETTER DELTA
 584   (#xC5 #x0395) ; GREEK CAPITAL LETTER EPSILON
 585   (#xC6 #x0396) ; GREEK CAPITAL LETTER ZETA
 586   (#xC7 #x0397) ; GREEK CAPITAL LETTER ETA
 587   (#xC8 #x0398) ; GREEK CAPITAL LETTER THETA
 588   (#xC9 #x0399) ; GREEK CAPITAL LETTER IOTA
 589   (#xCA #x039A) ; GREEK CAPITAL LETTER KAPPA
 590   (#xCB #x039B) ; GREEK CAPITAL LETTER LAMDA
 591   (#xCC #x039C) ; GREEK CAPITAL LETTER MU
 592   (#xCD #x039D) ; GREEK CAPITAL LETTER NU
 593   (#xCE #x039E) ; GREEK CAPITAL LETTER XI
 594   (#xCF #x039F) ; GREEK CAPITAL LETTER OMICRON
 595   (#xD0 #x03A0) ; GREEK CAPITAL LETTER PI
 596   (#xD1 #x03A1) ; GREEK CAPITAL LETTER RHO
 597   (#xD2 nil)
 598   (#xD3 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 599   (#xD4 #x03A4) ; GREEK CAPITAL LETTER TAU
 600   (#xD5 #x03A5) ; GREEK CAPITAL LETTER UPSILON
 601   (#xD6 #x03A6) ; GREEK CAPITAL LETTER PHI
 602   (#xD7 #x03A7) ; GREEK CAPITAL LETTER CHI
 603   (#xD8 #x03A8) ; GREEK CAPITAL LETTER PSI
 604   (#xD9 #x03A9) ; GREEK CAPITAL LETTER OMEGA
 605   (#xDA #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
 606   (#xDB #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
 607   (#xDC #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
 608   (#xDD #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
 609   (#xDE #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
 610   (#xDF #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
 611   (#xE0 #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
 612   (#xE1 #x03B1) ; GREEK SMALL LETTER ALPHA
 613   (#xE2 #x03B2) ; GREEK SMALL LETTER BETA
 614   (#xE3 #x03B3) ; GREEK SMALL LETTER GAMMA
 615   (#xE4 #x03B4) ; GREEK SMALL LETTER DELTA
 616   (#xE5 #x03B5) ; GREEK SMALL LETTER EPSILON
 617   (#xE6 #x03B6) ; GREEK SMALL LETTER ZETA
 618   (#xE7 #x03B7) ; GREEK SMALL LETTER ETA
 619   (#xE8 #x03B8) ; GREEK SMALL LETTER THETA
 620   (#xE9 #x03B9) ; GREEK SMALL LETTER IOTA
 621   (#xEA #x03BA) ; GREEK SMALL LETTER KAPPA
 622   (#xEB #x03BB) ; GREEK SMALL LETTER LAMDA
 623   (#xEC #x03BC) ; GREEK SMALL LETTER MU
 624   (#xED #x03BD) ; GREEK SMALL LETTER NU
 625   (#xEE #x03BE) ; GREEK SMALL LETTER XI
 626   (#xEF #x03BF) ; GREEK SMALL LETTER OMICRON
 627   (#xF0 #x03C0) ; GREEK SMALL LETTER PI
 628   (#xF1 #x03C1) ; GREEK SMALL LETTER RHO
 629   (#xF2 #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
 630   (#xF3 #x03C3) ; GREEK SMALL LETTER SIGMA
 631   (#xF4 #x03C4) ; GREEK SMALL LETTER TAU
 632   (#xF5 #x03C5) ; GREEK SMALL LETTER UPSILON
 633   (#xF6 #x03C6) ; GREEK SMALL LETTER PHI
 634   (#xF7 #x03C7) ; GREEK SMALL LETTER CHI
 635   (#xF8 #x03C8) ; GREEK SMALL LETTER PSI
 636   (#xF9 #x03C9) ; GREEK SMALL LETTER OMEGA
 637   (#xFA #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
 638   (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
 639   (#xFC #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
 640   (#xFD #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
 641   (#xFE #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
 642   (#xFF nil)
 643 )
 644
 645 (declaim (inline get-iso-8859-7-bytes))
 646 (defun get-iso-8859-7-bytes (string pos)
 647   (declare (optimize speed (safety 0))
 648            (type simple-string string)
 649            (type array-range pos))
 650   (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos))
 651
 652 (defun string->iso-8859-7 (string sstart send null-padding)
 653   (declare (optimize speed (safety 0))
 654            (type simple-string string)
 655            (type array-range sstart send))
 656   (values (string->latin% string sstart send #'get-iso-8859-7-bytes null-padding)))
 657
 658 (defmacro define-iso-8859-7->string* (accessor type)
 659   (declare (ignore type))
 660   (let ((name (make-od-name 'iso-8859-7->string* accessor)))
 661     `(progn
 662       (defun ,name (string sstart send array astart aend)
 663         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-7->code-mapper)))))
 664
 665 (instantiate-octets-definition define-iso-8859-7->string*)
 666
 667 (defmacro define-iso-8859-7->string (accessor type)
 668   (declare (ignore type))
 669   `(defun ,(make-od-name 'iso-8859-7->string accessor) (array astart aend)
 670     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-7->code-mapper)))
 671
 672 (instantiate-octets-definition define-iso-8859-7->string)
 673
 674 (add-external-format-funs '(:iso-8859-7 :|iso-8859-7|)
 675                           '(iso-8859-7->string-aref string->iso-8859-7))
 676
 677 (define-external-format (:iso-8859-7 :|iso-8859-7|)
 678     1 t
 679     (let ((iso-8859-7-byte (code->iso-8859-7-mapper bits)))
 680       (if iso-8859-7-byte
 681           (setf (sap-ref-8 sap tail) iso-8859-7-byte)
 682           (external-format-encoding-error stream bits)))
 683     (let ((code (iso-8859-7->code-mapper byte)))
 684       (if code
 685           (code-char code)
 686           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 687
 688 (define-unibyte-mapper iso-8859-8->code-mapper code->iso-8859-8-mapper
 689   (#xA1 nil)
 690   (#xAA #x00D7) ; MULTIPLICATION SIGN
 691   (#xAF #x203E) ; OVERLINE
 692   (#xBA #x00F7) ; DIVISION SIGN
 693   (#xBF nil)
 694   (#xC0 nil)
 695   (#xC1 nil)
 696   (#xC2 nil)
 697   (#xC3 nil)
 698   (#xC4 nil)
 699   (#xC5 nil)
 700   (#xC6 nil)
 701   (#xC7 nil)
 702   (#xC8 nil)
 703   (#xC9 nil)
 704   (#xCA nil)
 705   (#xCB nil)
 706   (#xCC nil)
 707   (#xCD nil)
 708   (#xCE nil)
 709   (#xCF nil)
 710   (#xD0 nil)
 711   (#xD1 nil)
 712   (#xD2 nil)
 713   (#xD3 nil)
 714   (#xD4 nil)
 715   (#xD5 nil)
 716   (#xD6 nil)
 717   (#xD7 nil)
 718   (#xD8 nil)
 719   (#xD9 nil)
 720   (#xDA nil)
 721   (#xDB nil)
 722   (#xDC nil)
 723   (#xDD nil)
 724   (#xDE nil)
 725   (#xDF #x2017) ; DOUBLE LOW LINE
 726   (#xE0 #x05D0) ; HEBREW LETTER ALEF
 727   (#xE1 #x05D1) ; HEBREW LETTER BET
 728   (#xE2 #x05D2) ; HEBREW LETTER GIMEL
 729   (#xE3 #x05D3) ; HEBREW LETTER DALET
 730   (#xE4 #x05D4) ; HEBREW LETTER HE
 731   (#xE5 #x05D5) ; HEBREW LETTER VAV
 732   (#xE6 #x05D6) ; HEBREW LETTER ZAYIN
 733   (#xE7 #x05D7) ; HEBREW LETTER HET
 734   (#xE8 #x05D8) ; HEBREW LETTER TET
 735   (#xE9 #x05D9) ; HEBREW LETTER YOD
 736   (#xEA #x05DA) ; HEBREW LETTER FINAL KAF
 737   (#xEB #x05DB) ; HEBREW LETTER KAF
 738   (#xEC #x05DC) ; HEBREW LETTER LAMED
 739   (#xED #x05DD) ; HEBREW LETTER FINAL MEM
 740   (#xEE #x05DE) ; HEBREW LETTER MEM
 741   (#xEF #x05DF) ; HEBREW LETTER FINAL NUN
 742   (#xF0 #x05E0) ; HEBREW LETTER NUN
 743   (#xF1 #x05E1) ; HEBREW LETTER SAMEKH
 744   (#xF2 #x05E2) ; HEBREW LETTER AYIN
 745   (#xF3 #x05E3) ; HEBREW LETTER FINAL PE
 746   (#xF4 #x05E4) ; HEBREW LETTER PE
 747   (#xF5 #x05E5) ; HEBREW LETTER FINAL TSADI
 748   (#xF6 #x05E6) ; HEBREW LETTER TSADI
 749   (#xF7 #x05E7) ; HEBREW LETTER QOF
 750   (#xF8 #x05E8) ; HEBREW LETTER RESH
 751   (#xF9 #x05E9) ; HEBREW LETTER SHIN
 752   (#xFA #x05EA) ; HEBREW LETTER TAV
 753   (#xFB nil)
 754   (#xFC nil)
 755   (#xFD nil)
 756   (#xFE nil)
 757   (#xFF nil)
 758 )
 759
 760 (declaim (inline get-iso-8859-8-bytes))
 761 (defun get-iso-8859-8-bytes (string pos)
 762   (declare (optimize speed (safety 0))
 763            (type simple-string string)
 764            (type array-range pos))
 765   (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos))
 766
 767 (defun string->iso-8859-8 (string sstart send null-padding)
 768   (declare (optimize speed (safety 0))
 769            (type simple-string string)
 770            (type array-range sstart send))
 771   (values (string->latin% string sstart send #'get-iso-8859-8-bytes null-padding)))
 772
 773 (defmacro define-iso-8859-8->string* (accessor type)
 774   (declare (ignore type))
 775   (let ((name (make-od-name 'iso-8859-8->string* accessor)))
 776     `(progn
 777       (defun ,name (string sstart send array astart aend)
 778         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-8->code-mapper)))))
 779
 780 (instantiate-octets-definition define-iso-8859-8->string*)
 781
 782 (defmacro define-iso-8859-8->string (accessor type)
 783   (declare (ignore type))
 784   `(defun ,(make-od-name 'iso-8859-8->string accessor) (array astart aend)
 785     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-8->code-mapper)))
 786
 787 (instantiate-octets-definition define-iso-8859-8->string)
 788
 789 (add-external-format-funs '(:iso-8859-8 :|iso-8859-8|)
 790                           '(iso-8859-8->string-aref string->iso-8859-8))
 791
 792 (define-external-format (:iso-8859-8 :|iso-8859-8|)
 793     1 t
 794     (let ((iso-8859-8-byte (code->iso-8859-8-mapper bits)))
 795       (if iso-8859-8-byte
 796           (setf (sap-ref-8 sap tail) iso-8859-8-byte)
 797           (external-format-encoding-error stream bits)))
 798     (let ((code (iso-8859-8->code-mapper byte)))
 799       (if code
 800           (code-char code)
 801           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 802
 803 (define-unibyte-mapper iso-8859-9->code-mapper code->iso-8859-9-mapper
 804   (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 805   (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 806   (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 807   (#xF0 #x011F) ; LATIN SMALL LETTER G WITH BREVE
 808   (#xFD #x0131) ; LATIN SMALL LETTER DOTLESS I
 809   (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 810 )
 811
 812 (declaim (inline get-iso-8859-9-bytes))
 813 (defun get-iso-8859-9-bytes (string pos)
 814   (declare (optimize speed (safety 0))
 815            (type simple-string string)
 816            (type array-range pos))
 817   (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos))
 818
 819 (defun string->iso-8859-9 (string sstart send null-padding)
 820   (declare (optimize speed (safety 0))
 821            (type simple-string string)
 822            (type array-range sstart send))
 823   (values (string->latin% string sstart send #'get-iso-8859-9-bytes null-padding)))
 824
 825 (defmacro define-iso-8859-9->string* (accessor type)
 826   (declare (ignore type))
 827   (let ((name (make-od-name 'iso-8859-9->string* accessor)))
 828     `(progn
 829       (defun ,name (string sstart send array astart aend)
 830         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-9->code-mapper)))))
 831
 832 (instantiate-octets-definition define-iso-8859-9->string*)
 833
 834 (defmacro define-iso-8859-9->string (accessor type)
 835   (declare (ignore type))
 836   `(defun ,(make-od-name 'iso-8859-9->string accessor) (array astart aend)
 837     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-9->code-mapper)))
 838
 839 (instantiate-octets-definition define-iso-8859-9->string)
 840
 841 (add-external-format-funs '(:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|)
 842                           '(iso-8859-9->string-aref string->iso-8859-9))
 843
 844 (define-external-format (:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|)
 845     1 t
 846     (let ((iso-8859-9-byte (code->iso-8859-9-mapper bits)))
 847       (if iso-8859-9-byte
 848           (setf (sap-ref-8 sap tail) iso-8859-9-byte)
 849           (external-format-encoding-error stream bits)))
 850     (let ((code (iso-8859-9->code-mapper byte)))
 851       (if code
 852           (code-char code)
 853           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 854
 855 (define-unibyte-mapper iso-8859-10->code-mapper code->iso-8859-10-mapper
 856   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 857   (#xA2 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 858   (#xA3 #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 859   (#xA4 #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 860   (#xA5 #x0128) ; LATIN CAPITAL LETTER I WITH TILDE
 861   (#xA6 #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 862   (#xA8 #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 863   (#xA9 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
 864   (#xAA #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 865   (#xAB #x0166) ; LATIN CAPITAL LETTER T WITH STROKE
 866   (#xAC #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 867   (#xAE #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 868   (#xAF #x014A) ; LATIN CAPITAL LETTER ENG
 869   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 870   (#xB2 #x0113) ; LATIN SMALL LETTER E WITH MACRON
 871   (#xB3 #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 872   (#xB4 #x012B) ; LATIN SMALL LETTER I WITH MACRON
 873   (#xB5 #x0129) ; LATIN SMALL LETTER I WITH TILDE
 874   (#xB6 #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 875   (#xB8 #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 876   (#xB9 #x0111) ; LATIN SMALL LETTER D WITH STROKE
 877   (#xBA #x0161) ; LATIN SMALL LETTER S WITH CARON
 878   (#xBB #x0167) ; LATIN SMALL LETTER T WITH STROKE
 879   (#xBC #x017E) ; LATIN SMALL LETTER Z WITH CARON
 880   (#xBD #x2015) ; HORIZONTAL BAR
 881   (#xBE #x016B) ; LATIN SMALL LETTER U WITH MACRON
 882   (#xBF #x014B) ; LATIN SMALL LETTER ENG
 883   (#xC0 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 884   (#xC7 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 885   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 886   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 887   (#xCC #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 888   (#xD1 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 889   (#xD2 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 890   (#xD7 #x0168) ; LATIN CAPITAL LETTER U WITH TILDE
 891   (#xD9 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 892   (#xE0 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 893   (#xE7 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 894   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 895   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 896   (#xEC #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 897   (#xF1 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 898   (#xF2 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 899   (#xF7 #x0169) ; LATIN SMALL LETTER U WITH TILDE
 900   (#xF9 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 901   (#xFF #x0138) ; LATIN SMALL LETTER KRA
 902 )
 903
 904 (declaim (inline get-iso-8859-10-bytes))
 905 (defun get-iso-8859-10-bytes (string pos)
 906   (declare (optimize speed (safety 0))
 907            (type simple-string string)
 908            (type array-range pos))
 909   (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos))
 910
 911 (defun string->iso-8859-10 (string sstart send null-padding)
 912   (declare (optimize speed (safety 0))
 913            (type simple-string string)
 914            (type array-range sstart send))
 915   (values (string->latin% string sstart send #'get-iso-8859-10-bytes null-padding)))
 916
 917 (defmacro define-iso-8859-10->string* (accessor type)
 918   (declare (ignore type))
 919   (let ((name (make-od-name 'iso-8859-10->string* accessor)))
 920     `(progn
 921       (defun ,name (string sstart send array astart aend)
 922         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-10->code-mapper)))))
 923
 924 (instantiate-octets-definition define-iso-8859-10->string*)
 925
 926 (defmacro define-iso-8859-10->string (accessor type)
 927   (declare (ignore type))
 928   `(defun ,(make-od-name 'iso-8859-10->string accessor) (array astart aend)
 929     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-10->code-mapper)))
 930
 931 (instantiate-octets-definition define-iso-8859-10->string)
 932
 933 (add-external-format-funs '(:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|)
 934                           '(iso-8859-10->string-aref string->iso-8859-10))
 935
 936 (define-external-format (:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|)
 937     1 t
 938     (let ((iso-8859-10-byte (code->iso-8859-10-mapper bits)))
 939       (if iso-8859-10-byte
 940           (setf (sap-ref-8 sap tail) iso-8859-10-byte)
 941           (external-format-encoding-error stream bits)))
 942     (let ((code (iso-8859-10->code-mapper byte)))
 943       (if code
 944           (code-char code)
 945           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 946
 947 (define-unibyte-mapper iso-8859-11->code-mapper code->iso-8859-11-mapper
 948   (#xA1 #x0E01) ; THAI CHARACTER KO KAI
 949   (#xA2 #x0E02) ; THAI CHARACTER KHO KHAI
 950   (#xA3 #x0E03) ; THAI CHARACTER KHO KHUAT
 951   (#xA4 #x0E04) ; THAI CHARACTER KHO KHWAI
 952   (#xA5 #x0E05) ; THAI CHARACTER KHO KHON
 953   (#xA6 #x0E06) ; THAI CHARACTER KHO RAKHANG
 954   (#xA7 #x0E07) ; THAI CHARACTER NGO NGU
 955   (#xA8 #x0E08) ; THAI CHARACTER CHO CHAN
 956   (#xA9 #x0E09) ; THAI CHARACTER CHO CHING
 957   (#xAA #x0E0A) ; THAI CHARACTER CHO CHANG
 958   (#xAB #x0E0B) ; THAI CHARACTER SO SO
 959   (#xAC #x0E0C) ; THAI CHARACTER CHO CHOE
 960   (#xAD #x0E0D) ; THAI CHARACTER YO YING
 961   (#xAE #x0E0E) ; THAI CHARACTER DO CHADA
 962   (#xAF #x0E0F) ; THAI CHARACTER TO PATAK
 963   (#xB0 #x0E10) ; THAI CHARACTER THO THAN
 964   (#xB1 #x0E11) ; THAI CHARACTER THO NANGMONTHO
 965   (#xB2 #x0E12) ; THAI CHARACTER THO PHUTHAO
 966   (#xB3 #x0E13) ; THAI CHARACTER NO NEN
 967   (#xB4 #x0E14) ; THAI CHARACTER DO DEK
 968   (#xB5 #x0E15) ; THAI CHARACTER TO TAO
 969   (#xB6 #x0E16) ; THAI CHARACTER THO THUNG
 970   (#xB7 #x0E17) ; THAI CHARACTER THO THAHAN
 971   (#xB8 #x0E18) ; THAI CHARACTER THO THONG
 972   (#xB9 #x0E19) ; THAI CHARACTER NO NU
 973   (#xBA #x0E1A) ; THAI CHARACTER BO BAIMAI
 974   (#xBB #x0E1B) ; THAI CHARACTER PO PLA
 975   (#xBC #x0E1C) ; THAI CHARACTER PHO PHUNG
 976   (#xBD #x0E1D) ; THAI CHARACTER FO FA
 977   (#xBE #x0E1E) ; THAI CHARACTER PHO PHAN
 978   (#xBF #x0E1F) ; THAI CHARACTER FO FAN
 979   (#xC0 #x0E20) ; THAI CHARACTER PHO SAMPHAO
 980   (#xC1 #x0E21) ; THAI CHARACTER MO MA
 981   (#xC2 #x0E22) ; THAI CHARACTER YO YAK
 982   (#xC3 #x0E23) ; THAI CHARACTER RO RUA
 983   (#xC4 #x0E24) ; THAI CHARACTER RU
 984   (#xC5 #x0E25) ; THAI CHARACTER LO LING
 985   (#xC6 #x0E26) ; THAI CHARACTER LU
 986   (#xC7 #x0E27) ; THAI CHARACTER WO WAEN
 987   (#xC8 #x0E28) ; THAI CHARACTER SO SALA
 988   (#xC9 #x0E29) ; THAI CHARACTER SO RUSI
 989   (#xCA #x0E2A) ; THAI CHARACTER SO SUA
 990   (#xCB #x0E2B) ; THAI CHARACTER HO HIP
 991   (#xCC #x0E2C) ; THAI CHARACTER LO CHULA
 992   (#xCD #x0E2D) ; THAI CHARACTER O ANG
 993   (#xCE #x0E2E) ; THAI CHARACTER HO NOKHUK
 994   (#xCF #x0E2F) ; THAI CHARACTER PAIYANNOI
 995   (#xD0 #x0E30) ; THAI CHARACTER SARA A
 996   (#xD1 #x0E31) ; THAI CHARACTER MAI HAN-AKAT
 997   (#xD2 #x0E32) ; THAI CHARACTER SARA AA
 998   (#xD3 #x0E33) ; THAI CHARACTER SARA AM
 999   (#xD4 #x0E34) ; THAI CHARACTER SARA I
1000   (#xD5 #x0E35) ; THAI CHARACTER SARA II
1001   (#xD6 #x0E36) ; THAI CHARACTER SARA UE
1002   (#xD7 #x0E37) ; THAI CHARACTER SARA UEE
1003   (#xD8 #x0E38) ; THAI CHARACTER SARA U
1004   (#xD9 #x0E39) ; THAI CHARACTER SARA UU
1005   (#xDA #x0E3A) ; THAI CHARACTER PHINTHU
1006   (#xDB nil)
1007   (#xDC nil)
1008   (#xDD nil)
1009   (#xDE nil)
1010   (#xDF #x0E3F) ; THAI CURRENCY SYMBOL BAHT
1011   (#xE0 #x0E40) ; THAI CHARACTER SARA E
1012   (#xE1 #x0E41) ; THAI CHARACTER SARA AE
1013   (#xE2 #x0E42) ; THAI CHARACTER SARA O
1014   (#xE3 #x0E43) ; THAI CHARACTER SARA AI MAIMUAN
1015   (#xE4 #x0E44) ; THAI CHARACTER SARA AI MAIMALAI
1016   (#xE5 #x0E45) ; THAI CHARACTER LAKKHANGYAO
1017   (#xE6 #x0E46) ; THAI CHARACTER MAIYAMOK
1018   (#xE7 #x0E47) ; THAI CHARACTER MAITAIKHU
1019   (#xE8 #x0E48) ; THAI CHARACTER MAI EK
1020   (#xE9 #x0E49) ; THAI CHARACTER MAI THO
1021   (#xEA #x0E4A) ; THAI CHARACTER MAI TRI
1022   (#xEB #x0E4B) ; THAI CHARACTER MAI CHATTAWA
1023   (#xEC #x0E4C) ; THAI CHARACTER THANTHAKHAT
1024   (#xED #x0E4D) ; THAI CHARACTER NIKHAHIT
1025   (#xEE #x0E4E) ; THAI CHARACTER YAMAKKAN
1026   (#xEF #x0E4F) ; THAI CHARACTER FONGMAN
1027   (#xF0 #x0E50) ; THAI DIGIT ZERO
1028   (#xF1 #x0E51) ; THAI DIGIT ONE
1029   (#xF2 #x0E52) ; THAI DIGIT TWO
1030   (#xF3 #x0E53) ; THAI DIGIT THREE
1031   (#xF4 #x0E54) ; THAI DIGIT FOUR
1032   (#xF5 #x0E55) ; THAI DIGIT FIVE
1033   (#xF6 #x0E56) ; THAI DIGIT SIX
1034   (#xF7 #x0E57) ; THAI DIGIT SEVEN
1035   (#xF8 #x0E58) ; THAI DIGIT EIGHT
1036   (#xF9 #x0E59) ; THAI DIGIT NINE
1037   (#xFA #x0E5A) ; THAI CHARACTER ANGKHANKHU
1038   (#xFB #x0E5B) ; THAI CHARACTER KHOMUT
1039   (#xFC nil)
1040   (#xFD nil)
1041   (#xFE nil)
1042   (#xFF nil)
1043 )
1044
1045 (declaim (inline get-iso-8859-11-bytes))
1046 (defun get-iso-8859-11-bytes (string pos)
1047   (declare (optimize speed (safety 0))
1048            (type simple-string string)
1049            (type array-range pos))
1050   (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos))
1051
1052 (defun string->iso-8859-11 (string sstart send null-padding)
1053   (declare (optimize speed (safety 0))
1054            (type simple-string string)
1055            (type array-range sstart send))
1056   (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding)))
1057
1058 (defmacro define-iso-8859-11->string* (accessor type)
1059   (declare (ignore type))
1060   (let ((name (make-od-name 'iso-8859-11->string* accessor)))
1061     `(progn
1062       (defun ,name (string sstart send array astart aend)
1063         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-11->code-mapper)))))
1064
1065 (instantiate-octets-definition define-iso-8859-11->string*)
1066
1067 (defmacro define-iso-8859-11->string (accessor type)
1068   (declare (ignore type))
1069   `(defun ,(make-od-name 'iso-8859-11->string accessor) (array astart aend)
1070     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-11->code-mapper)))
1071
1072 (instantiate-octets-definition define-iso-8859-11->string)
1073
1074 (add-external-format-funs '(:iso-8859-11 :|iso-8859-11|)
1075                           '(iso-8859-11->string-aref string->iso-8859-11))
1076
1077 (define-external-format (:iso-8859-11 :|iso-8859-11|)
1078     1 t
1079     (let ((iso-8859-11-byte (code->iso-8859-11-mapper bits)))
1080       (if iso-8859-11-byte
1081           (setf (sap-ref-8 sap tail) iso-8859-11-byte)
1082           (external-format-encoding-error stream bits)))
1083     (let ((code (iso-8859-11->code-mapper byte)))
1084       (if code
1085           (code-char code)
1086           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1087
1088 (define-unibyte-mapper iso-8859-13->code-mapper code->iso-8859-13-mapper
1089   (#xA1 #x201D) ; RIGHT DOUBLE QUOTATION MARK
1090   (#xA5 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
1091   (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
1092   (#xAA #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
1093   (#xAF #x00C6) ; LATIN CAPITAL LETTER AE
1094   (#xB4 #x201C) ; LEFT DOUBLE QUOTATION MARK
1095   (#xB8 #x00F8) ; LATIN SMALL LETTER O WITH STROKE
1096   (#xBA #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
1097   (#xBF #x00E6) ; LATIN SMALL LETTER AE
1098   (#xC0 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
1099   (#xC1 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
1100   (#xC2 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
1101   (#xC3 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
1102   (#xC6 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
1103   (#xC7 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
1104   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
1105   (#xCA #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
1106   (#xCB #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
1107   (#xCC #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
1108   (#xCD #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
1109   (#xCE #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
1110   (#xCF #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
1111   (#xD0 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
1112   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
1113   (#xD2 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
1114   (#xD4 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
1115   (#xD8 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
1116   (#xD9 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
1117   (#xDA #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
1118   (#xDB #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
1119   (#xDD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
1120   (#xDE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
1121   (#xE0 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
1122   (#xE1 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
1123   (#xE2 #x0101) ; LATIN SMALL LETTER A WITH MACRON
1124   (#xE3 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
1125   (#xE6 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
1126   (#xE7 #x0113) ; LATIN SMALL LETTER E WITH MACRON
1127   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
1128   (#xEA #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
1129   (#xEB #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
1130   (#xEC #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
1131   (#xED #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
1132   (#xEE #x012B) ; LATIN SMALL LETTER I WITH MACRON
1133   (#xEF #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
1134   (#xF0 #x0161) ; LATIN SMALL LETTER S WITH CARON
1135   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
1136   (#xF2 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
1137   (#xF4 #x014D) ; LATIN SMALL LETTER O WITH MACRON
1138   (#xF8 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
1139   (#xF9 #x0142) ; LATIN SMALL LETTER L WITH STROKE
1140   (#xFA #x015B) ; LATIN SMALL LETTER S WITH ACUTE
1141   (#xFB #x016B) ; LATIN SMALL LETTER U WITH MACRON
1142   (#xFD #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
1143   (#xFE #x017E) ; LATIN SMALL LETTER Z WITH CARON
1144   (#xFF #x2019) ; RIGHT SINGLE QUOTATION MARK
1145 )
1146
1147 (declaim (inline get-iso-8859-13-bytes))
1148 (defun get-iso-8859-13-bytes (string pos)
1149   (declare (optimize speed (safety 0))
1150            (type simple-string string)
1151            (type array-range pos))
1152   (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos))
1153
1154 (defun string->iso-8859-13 (string sstart send null-padding)
1155   (declare (optimize speed (safety 0))
1156            (type simple-string string)
1157            (type array-range sstart send))
1158   (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding)))
1159
1160 (defmacro define-iso-8859-13->string* (accessor type)
1161   (declare (ignore type))
1162   (let ((name (make-od-name 'iso-8859-13->string* accessor)))
1163     `(progn
1164       (defun ,name (string sstart send array astart aend)
1165         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-13->code-mapper)))))
1166
1167 (instantiate-octets-definition define-iso-8859-13->string*)
1168
1169 (defmacro define-iso-8859-13->string (accessor type)
1170   (declare (ignore type))
1171   `(defun ,(make-od-name 'iso-8859-13->string accessor) (array astart aend)
1172     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-13->code-mapper)))
1173
1174 (instantiate-octets-definition define-iso-8859-13->string)
1175
1176 (add-external-format-funs '(:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|)
1177                           '(iso-8859-13->string-aref string->iso-8859-13))
1178
1179 (define-external-format (:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|)
1180     1 t
1181     (let ((iso-8859-13-byte (code->iso-8859-13-mapper bits)))
1182       (if iso-8859-13-byte
1183           (setf (sap-ref-8 sap tail) iso-8859-13-byte)
1184           (external-format-encoding-error stream bits)))
1185     (let ((code (iso-8859-13->code-mapper byte)))
1186       (if code
1187           (code-char code)
1188           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1189
1190 (define-unibyte-mapper iso-8859-14->code-mapper code->iso-8859-14-mapper
1191   (#xA1 #x1E02) ; LATIN CAPITAL LETTER B WITH DOT ABOVE
1192   (#xA2 #x1E03) ; LATIN SMALL LETTER B WITH DOT ABOVE
1193   (#xA4 #x010A) ; LATIN CAPITAL LETTER C WITH DOT ABOVE
1194   (#xA5 #x010B) ; LATIN SMALL LETTER C WITH DOT ABOVE
1195   (#xA6 #x1E0A) ; LATIN CAPITAL LETTER D WITH DOT ABOVE
1196   (#xA8 #x1E80) ; LATIN CAPITAL LETTER W WITH GRAVE
1197   (#xAA #x1E82) ; LATIN CAPITAL LETTER W WITH ACUTE
1198   (#xAB #x1E0B) ; LATIN SMALL LETTER D WITH DOT ABOVE
1199   (#xAC #x1EF2) ; LATIN CAPITAL LETTER Y WITH GRAVE
1200   (#xAF #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
1201   (#xB0 #x1E1E) ; LATIN CAPITAL LETTER F WITH DOT ABOVE
1202   (#xB1 #x1E1F) ; LATIN SMALL LETTER F WITH DOT ABOVE
1203   (#xB2 #x0120) ; LATIN CAPITAL LETTER G WITH DOT ABOVE
1204   (#xB3 #x0121) ; LATIN SMALL LETTER G WITH DOT ABOVE
1205   (#xB4 #x1E40) ; LATIN CAPITAL LETTER M WITH DOT ABOVE
1206   (#xB5 #x1E41) ; LATIN SMALL LETTER M WITH DOT ABOVE
1207   (#xB7 #x1E56) ; LATIN CAPITAL LETTER P WITH DOT ABOVE
1208   (#xB8 #x1E81) ; LATIN SMALL LETTER W WITH GRAVE
1209   (#xB9 #x1E57) ; LATIN SMALL LETTER P WITH DOT ABOVE
1210   (#xBA #x1E83) ; LATIN SMALL LETTER W WITH ACUTE
1211   (#xBB #x1E60) ; LATIN CAPITAL LETTER S WITH DOT ABOVE
1212   (#xBC #x1EF3) ; LATIN SMALL LETTER Y WITH GRAVE
1213   (#xBD #x1E84) ; LATIN CAPITAL LETTER W WITH DIAERESIS
1214   (#xBE #x1E85) ; LATIN SMALL LETTER W WITH DIAERESIS
1215   (#xBF #x1E61) ; LATIN SMALL LETTER S WITH DOT ABOVE
1216   (#xD0 #x0174) ; LATIN CAPITAL LETTER W WITH CIRCUMFLEX
1217   (#xD7 #x1E6A) ; LATIN CAPITAL LETTER T WITH DOT ABOVE
1218   (#xDE #x0176) ; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
1219   (#xF0 #x0175) ; LATIN SMALL LETTER W WITH CIRCUMFLEX
1220   (#xF7 #x1E6B) ; LATIN SMALL LETTER T WITH DOT ABOVE
1221   (#xFE #x0177) ; LATIN SMALL LETTER Y WITH CIRCUMFLEX
1222 )
1223
1224 (declaim (inline get-iso-8859-14-bytes))
1225 (defun get-iso-8859-14-bytes (string pos)
1226   (declare (optimize speed (safety 0))
1227            (type simple-string string)
1228            (type array-range pos))
1229   (get-latin-bytes #'code->iso-8859-14-mapper :iso-8859-14 string pos))
1230
1231 (defun string->iso-8859-14 (string sstart send null-padding)
1232   (declare (optimize speed (safety 0))
1233            (type simple-string string)
1234            (type array-range sstart send))
1235   (values (string->latin% string sstart send #'get-iso-8859-14-bytes null-padding)))
1236
1237 (defmacro define-iso-8859-14->string* (accessor type)
1238   (declare (ignore type))
1239   (let ((name (make-od-name 'iso-8859-14->string* accessor)))
1240     `(progn
1241       (defun ,name (string sstart send array astart aend)
1242         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-14->code-mapper)))))
1243
1244 (instantiate-octets-definition define-iso-8859-14->string*)
1245
1246 (defmacro define-iso-8859-14->string (accessor type)
1247   (declare (ignore type))
1248   `(defun ,(make-od-name 'iso-8859-14->string accessor) (array astart aend)
1249     (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-14->code-mapper)))
1250
1251 (instantiate-octets-definition define-iso-8859-14->string)
1252
1253 (add-external-format-funs '(:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|)
1254                           '(iso-8859-14->string-aref string->iso-8859-14))
1255
1256 (define-external-format (:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|)
1257     1 t
1258     (let ((iso-8859-14-byte (code->iso-8859-14-mapper bits)))
1259       (if iso-8859-14-byte
1260           (setf (sap-ref-8 sap tail) iso-8859-14-byte)
1261           (external-format-encoding-error stream bits)))
1262     (let ((code (iso-8859-14->code-mapper byte)))
1263       (if code
1264           (code-char code)
1265           (external-format-decoding-error stream byte)))) ;; TODO -- error check