enc-iso.lisp

开源跨平台Lisp编译器

  (#xA5 #x0E05) ; THAI CHARACTER KHO KHON
  (#xA6 #x0E06) ; THAI CHARACTER KHO RAKHANG
  (#xA7 #x0E07) ; THAI CHARACTER NGO NGU
  (#xA8 #x0E08) ; THAI CHARACTER CHO CHAN
  (#xA9 #x0E09) ; THAI CHARACTER CHO CHING
  (#xAA #x0E0A) ; THAI CHARACTER CHO CHANG
  (#xAB #x0E0B) ; THAI CHARACTER SO SO
  (#xAC #x0E0C) ; THAI CHARACTER CHO CHOE
  (#xAD #x0E0D) ; THAI CHARACTER YO YING
  (#xAE #x0E0E) ; THAI CHARACTER DO CHADA
  (#xAF #x0E0F) ; THAI CHARACTER TO PATAK
  (#xB0 #x0E10) ; THAI CHARACTER THO THAN
  (#xB1 #x0E11) ; THAI CHARACTER THO NANGMONTHO
  (#xB2 #x0E12) ; THAI CHARACTER THO PHUTHAO
  (#xB3 #x0E13) ; THAI CHARACTER NO NEN
  (#xB4 #x0E14) ; THAI CHARACTER DO DEK
  (#xB5 #x0E15) ; THAI CHARACTER TO TAO
  (#xB6 #x0E16) ; THAI CHARACTER THO THUNG
  (#xB7 #x0E17) ; THAI CHARACTER THO THAHAN
  (#xB8 #x0E18) ; THAI CHARACTER THO THONG
  (#xB9 #x0E19) ; THAI CHARACTER NO NU
  (#xBA #x0E1A) ; THAI CHARACTER BO BAIMAI
  (#xBB #x0E1B) ; THAI CHARACTER PO PLA
  (#xBC #x0E1C) ; THAI CHARACTER PHO PHUNG
  (#xBD #x0E1D) ; THAI CHARACTER FO FA
  (#xBE #x0E1E) ; THAI CHARACTER PHO PHAN
  (#xBF #x0E1F) ; THAI CHARACTER FO FAN
  (#xC0 #x0E20) ; THAI CHARACTER PHO SAMPHAO
  (#xC1 #x0E21) ; THAI CHARACTER MO MA
  (#xC2 #x0E22) ; THAI CHARACTER YO YAK
  (#xC3 #x0E23) ; THAI CHARACTER RO RUA
  (#xC4 #x0E24) ; THAI CHARACTER RU
  (#xC5 #x0E25) ; THAI CHARACTER LO LING
  (#xC6 #x0E26) ; THAI CHARACTER LU
  (#xC7 #x0E27) ; THAI CHARACTER WO WAEN
  (#xC8 #x0E28) ; THAI CHARACTER SO SALA
  (#xC9 #x0E29) ; THAI CHARACTER SO RUSI
  (#xCA #x0E2A) ; THAI CHARACTER SO SUA
  (#xCB #x0E2B) ; THAI CHARACTER HO HIP
  (#xCC #x0E2C) ; THAI CHARACTER LO CHULA
  (#xCD #x0E2D) ; THAI CHARACTER O ANG
  (#xCE #x0E2E) ; THAI CHARACTER HO NOKHUK
  (#xCF #x0E2F) ; THAI CHARACTER PAIYANNOI
  (#xD0 #x0E30) ; THAI CHARACTER SARA A
  (#xD1 #x0E31) ; THAI CHARACTER MAI HAN-AKAT
  (#xD2 #x0E32) ; THAI CHARACTER SARA AA
  (#xD3 #x0E33) ; THAI CHARACTER SARA AM
  (#xD4 #x0E34) ; THAI CHARACTER SARA I
  (#xD5 #x0E35) ; THAI CHARACTER SARA II
  (#xD6 #x0E36) ; THAI CHARACTER SARA UE
  (#xD7 #x0E37) ; THAI CHARACTER SARA UEE
  (#xD8 #x0E38) ; THAI CHARACTER SARA U
  (#xD9 #x0E39) ; THAI CHARACTER SARA UU
  (#xDA #x0E3A) ; THAI CHARACTER PHINTHU
  (#xDB nil)
  (#xDC nil)
  (#xDD nil)
  (#xDE nil)
  (#xDF #x0E3F) ; THAI CURRENCY SYMBOL BAHT
  (#xE0 #x0E40) ; THAI CHARACTER SARA E
  (#xE1 #x0E41) ; THAI CHARACTER SARA AE
  (#xE2 #x0E42) ; THAI CHARACTER SARA O
  (#xE3 #x0E43) ; THAI CHARACTER SARA AI MAIMUAN
  (#xE4 #x0E44) ; THAI CHARACTER SARA AI MAIMALAI
  (#xE5 #x0E45) ; THAI CHARACTER LAKKHANGYAO
  (#xE6 #x0E46) ; THAI CHARACTER MAIYAMOK
  (#xE7 #x0E47) ; THAI CHARACTER MAITAIKHU
  (#xE8 #x0E48) ; THAI CHARACTER MAI EK
  (#xE9 #x0E49) ; THAI CHARACTER MAI THO
  (#xEA #x0E4A) ; THAI CHARACTER MAI TRI
  (#xEB #x0E4B) ; THAI CHARACTER MAI CHATTAWA
  (#xEC #x0E4C) ; THAI CHARACTER THANTHAKHAT
  (#xED #x0E4D) ; THAI CHARACTER NIKHAHIT
  (#xEE #x0E4E) ; THAI CHARACTER YAMAKKAN
  (#xEF #x0E4F) ; THAI CHARACTER FONGMAN
  (#xF0 #x0E50) ; THAI DIGIT ZERO
  (#xF1 #x0E51) ; THAI DIGIT ONE
  (#xF2 #x0E52) ; THAI DIGIT TWO
  (#xF3 #x0E53) ; THAI DIGIT THREE
  (#xF4 #x0E54) ; THAI DIGIT FOUR
  (#xF5 #x0E55) ; THAI DIGIT FIVE
  (#xF6 #x0E56) ; THAI DIGIT SIX
  (#xF7 #x0E57) ; THAI DIGIT SEVEN
  (#xF8 #x0E58) ; THAI DIGIT EIGHT
  (#xF9 #x0E59) ; THAI DIGIT NINE
  (#xFA #x0E5A) ; THAI CHARACTER ANGKHANKHU
  (#xFB #x0E5B) ; THAI CHARACTER KHOMUT
  (#xFC nil)
  (#xFD nil)
  (#xFE nil)
  (#xFF nil)
)

(declaim (inline get-iso-8859-11-bytes))
(defun get-iso-8859-11-bytes (string pos)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range pos))
  (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos))

(defun string->iso-8859-11 (string sstart send null-padding)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range sstart send))
  (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding)))

(defmacro define-iso-8859-11->string* (accessor type)
  (declare (ignore type))
  (let ((name (make-od-name 'iso-8859-11->string* accessor)))
    `(progn
      (defun ,name (string sstart send array astart aend)
        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-11->code-mapper)))))

(instantiate-octets-definition define-iso-8859-11->string*)

(defmacro define-iso-8859-11->string (accessor type)
  (declare (ignore type))
  `(defun ,(make-od-name 'iso-8859-11->string accessor) (array astart aend)
    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-11->code-mapper)))

(instantiate-octets-definition define-iso-8859-11->string)

(add-external-format-funs '(:iso-8859-11 :|iso-8859-11|)
                          '(iso-8859-11->string-aref string->iso-8859-11))

(define-external-format (:iso-8859-11 :|iso-8859-11|)
    1 t
    (let ((iso-8859-11-byte (code->iso-8859-11-mapper bits)))
      (if iso-8859-11-byte
          (setf (sap-ref-8 sap tail) iso-8859-11-byte)
          (external-format-encoding-error stream bits)))
    (let ((code (iso-8859-11->code-mapper byte)))
      (if code
          (code-char code)
          (external-format-decoding-error stream byte)))) ;; TODO -- error check

(define-unibyte-mapper iso-8859-13->code-mapper code->iso-8859-13-mapper
  (#xA1 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  (#xA5 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
  (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
  (#xAA #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
  (#xAF #x00C6) ; LATIN CAPITAL LETTER AE
  (#xB4 #x201C) ; LEFT DOUBLE QUOTATION MARK
  (#xB8 #x00F8) ; LATIN SMALL LETTER O WITH STROKE
  (#xBA #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
  (#xBF #x00E6) ; LATIN SMALL LETTER AE
  (#xC0 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
  (#xC1 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
  (#xC2 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
  (#xC3 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
  (#xC6 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
  (#xC7 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
  (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
  (#xCA #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
  (#xCB #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
  (#xCC #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
  (#xCD #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
  (#xCE #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
  (#xCF #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
  (#xD0 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
  (#xD2 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
  (#xD4 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
  (#xD8 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
  (#xD9 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
  (#xDA #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
  (#xDB #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
  (#xDD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
  (#xDE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
  (#xE0 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
  (#xE1 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
  (#xE2 #x0101) ; LATIN SMALL LETTER A WITH MACRON
  (#xE3 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
  (#xE6 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
  (#xE7 #x0113) ; LATIN SMALL LETTER E WITH MACRON
  (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
  (#xEA #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
  (#xEB #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
  (#xEC #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
  (#xED #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
  (#xEE #x012B) ; LATIN SMALL LETTER I WITH MACRON
  (#xEF #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
  (#xF0 #x0161) ; LATIN SMALL LETTER S WITH CARON
  (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
  (#xF2 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
  (#xF4 #x014D) ; LATIN SMALL LETTER O WITH MACRON
  (#xF8 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
  (#xF9 #x0142) ; LATIN SMALL LETTER L WITH STROKE
  (#xFA #x015B) ; LATIN SMALL LETTER S WITH ACUTE
  (#xFB #x016B) ; LATIN SMALL LETTER U WITH MACRON
  (#xFD #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
  (#xFE #x017E) ; LATIN SMALL LETTER Z WITH CARON
  (#xFF #x2019) ; RIGHT SINGLE QUOTATION MARK
)

(declaim (inline get-iso-8859-13-bytes))
(defun get-iso-8859-13-bytes (string pos)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range pos))
  (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos))

(defun string->iso-8859-13 (string sstart send null-padding)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range sstart send))
  (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding)))

(defmacro define-iso-8859-13->string* (accessor type)
  (declare (ignore type))
  (let ((name (make-od-name 'iso-8859-13->string* accessor)))
    `(progn
      (defun ,name (string sstart send array astart aend)
        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-13->code-mapper)))))

(instantiate-octets-definition define-iso-8859-13->string*)

(defmacro define-iso-8859-13->string (accessor type)
  (declare (ignore type))
  `(defun ,(make-od-name 'iso-8859-13->string accessor) (array astart aend)
    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-13->code-mapper)))

(instantiate-octets-definition define-iso-8859-13->string)

(add-external-format-funs '(:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|)
                          '(iso-8859-13->string-aref string->iso-8859-13))

(define-external-format (:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|)
    1 t
    (let ((iso-8859-13-byte (code->iso-8859-13-mapper bits)))
      (if iso-8859-13-byte
          (setf (sap-ref-8 sap tail) iso-8859-13-byte)
          (external-format-encoding-error stream bits)))
    (let ((code (iso-8859-13->code-mapper byte)))
      (if code
          (code-char code)
          (external-format-decoding-error stream byte)))) ;; TODO -- error check

(define-unibyte-mapper iso-8859-14->code-mapper code->iso-8859-14-mapper
  (#xA1 #x1E02) ; LATIN CAPITAL LETTER B WITH DOT ABOVE
  (#xA2 #x1E03) ; LATIN SMALL LETTER B WITH DOT ABOVE
  (#xA4 #x010A) ; LATIN CAPITAL LETTER C WITH DOT ABOVE
  (#xA5 #x010B) ; LATIN SMALL LETTER C WITH DOT ABOVE
  (#xA6 #x1E0A) ; LATIN CAPITAL LETTER D WITH DOT ABOVE
  (#xA8 #x1E80) ; LATIN CAPITAL LETTER W WITH GRAVE
  (#xAA #x1E82) ; LATIN CAPITAL LETTER W WITH ACUTE
  (#xAB #x1E0B) ; LATIN SMALL LETTER D WITH DOT ABOVE
  (#xAC #x1EF2) ; LATIN CAPITAL LETTER Y WITH GRAVE
  (#xAF #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
  (#xB0 #x1E1E) ; LATIN CAPITAL LETTER F WITH DOT ABOVE
  (#xB1 #x1E1F) ; LATIN SMALL LETTER F WITH DOT ABOVE
  (#xB2 #x0120) ; LATIN CAPITAL LETTER G WITH DOT ABOVE
  (#xB3 #x0121) ; LATIN SMALL LETTER G WITH DOT ABOVE
  (#xB4 #x1E40) ; LATIN CAPITAL LETTER M WITH DOT ABOVE
  (#xB5 #x1E41) ; LATIN SMALL LETTER M WITH DOT ABOVE
  (#xB7 #x1E56) ; LATIN CAPITAL LETTER P WITH DOT ABOVE
  (#xB8 #x1E81) ; LATIN SMALL LETTER W WITH GRAVE
  (#xB9 #x1E57) ; LATIN SMALL LETTER P WITH DOT ABOVE
  (#xBA #x1E83) ; LATIN SMALL LETTER W WITH ACUTE
  (#xBB #x1E60) ; LATIN CAPITAL LETTER S WITH DOT ABOVE
  (#xBC #x1EF3) ; LATIN SMALL LETTER Y WITH GRAVE
  (#xBD #x1E84) ; LATIN CAPITAL LETTER W WITH DIAERESIS
  (#xBE #x1E85) ; LATIN SMALL LETTER W WITH DIAERESIS
  (#xBF #x1E61) ; LATIN SMALL LETTER S WITH DOT ABOVE
  (#xD0 #x0174) ; LATIN CAPITAL LETTER W WITH CIRCUMFLEX
  (#xD7 #x1E6A) ; LATIN CAPITAL LETTER T WITH DOT ABOVE
  (#xDE #x0176) ; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
  (#xF0 #x0175) ; LATIN SMALL LETTER W WITH CIRCUMFLEX
  (#xF7 #x1E6B) ; LATIN SMALL LETTER T WITH DOT ABOVE
  (#xFE #x0177) ; LATIN SMALL LETTER Y WITH CIRCUMFLEX
)

(declaim (inline get-iso-8859-14-bytes))
(defun get-iso-8859-14-bytes (string pos)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range pos))
  (get-latin-bytes #'code->iso-8859-14-mapper :iso-8859-14 string pos))

(defun string->iso-8859-14 (string sstart send null-padding)
  (declare (optimize speed (safety 0))
           (type simple-string string)
           (type array-range sstart send))
  (values (string->latin% string sstart send #'get-iso-8859-14-bytes null-padding)))

(defmacro define-iso-8859-14->string* (accessor type)
  (declare (ignore type))
  (let ((name (make-od-name 'iso-8859-14->string* accessor)))
    `(progn
      (defun ,name (string sstart send array astart aend)
        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-14->code-mapper)))))

(instantiate-octets-definition define-iso-8859-14->string*)

(defmacro define-iso-8859-14->string (accessor type)
  (declare (ignore type))
  `(defun ,(make-od-name 'iso-8859-14->string accessor) (array astart aend)
    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-14->code-mapper)))

(instantiate-octets-definition define-iso-8859-14->string)

(add-external-format-funs '(:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|)
                          '(iso-8859-14->string-aref string->iso-8859-14))

(define-external-format (:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|)
    1 t
    (let ((iso-8859-14-byte (code->iso-8859-14-mapper bits)))
      (if iso-8859-14-byte
          (setf (sap-ref-8 sap tail) iso-8859-14-byte)
          (external-format-encoding-error stream bits)))
    (let ((code (iso-8859-14->code-mapper byte)))
      (if code
          (code-char code)
          (external-format-decoding-error stream byte)))) ;; TODO -- error check