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