enc-win.lisp

开源跨平台Lisp编译器

  (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
  (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
  (#x85 #x2026) ; HORIZONTAL ELLIPSIS
  (#x86 #x2020) ; DAGGER
  (#x87 #x2021) ; DOUBLE DAGGER
  (#x88 nil)
  (#x89 #x2030) ; PER MILLE SIGN
  (#x8A nil)
  (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
  (#x8C nil)
  (#x8D nil)
  (#x8E nil)
  (#x8F nil)
  (#x90 nil)
  (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
  (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
  (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
  (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  (#x95 #x2022) ; BULLET
  (#x96 #x2013) ; EN DASH
  (#x97 #x2014) ; EM DASH
  (#x98 nil)
  (#x99 #x2122) ; TRADE MARK SIGN
  (#x9A nil)
  (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
  (#x9C nil)
  (#x9D nil)
  (#x9E nil)
  (#x9F nil)
  (#xA1 #x0385) ; GREEK DIALYTIKA TONOS
  (#xA2 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
  (#xAA nil)
  (#xAF #x2015) ; HORIZONTAL BAR
  (#xB4 #x0384) ; GREEK TONOS
  (#xB8 #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
  (#xB9 #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
  (#xBA #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
  (#xBC #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
  (#xBE #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
  (#xBF #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
  (#xC0 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
  (#xC1 #x0391) ; GREEK CAPITAL LETTER ALPHA
  (#xC2 #x0392) ; GREEK CAPITAL LETTER BETA
  (#xC3 #x0393) ; GREEK CAPITAL LETTER GAMMA
  (#xC4 #x0394) ; GREEK CAPITAL LETTER DELTA
  (#xC5 #x0395) ; GREEK CAPITAL LETTER EPSILON
  (#xC6 #x0396) ; GREEK CAPITAL LETTER ZETA
  (#xC7 #x0397) ; GREEK CAPITAL LETTER ETA
  (#xC8 #x0398) ; GREEK CAPITAL LETTER THETA
  (#xC9 #x0399) ; GREEK CAPITAL LETTER IOTA
  (#xCA #x039A) ; GREEK CAPITAL LETTER KAPPA
  (#xCB #x039B) ; GREEK CAPITAL LETTER LAMDA
  (#xCC #x039C) ; GREEK CAPITAL LETTER MU
  (#xCD #x039D) ; GREEK CAPITAL LETTER NU
  (#xCE #x039E) ; GREEK CAPITAL LETTER XI
  (#xCF #x039F) ; GREEK CAPITAL LETTER OMICRON
  (#xD0 #x03A0) ; GREEK CAPITAL LETTER PI
  (#xD1 #x03A1) ; GREEK CAPITAL LETTER RHO
  (#xD2 nil)
  (#xD3 #x03A3) ; GREEK CAPITAL LETTER SIGMA
  (#xD4 #x03A4) ; GREEK CAPITAL LETTER TAU
  (#xD5 #x03A5) ; GREEK CAPITAL LETTER UPSILON
  (#xD6 #x03A6) ; GREEK CAPITAL LETTER PHI
  (#xD7 #x03A7) ; GREEK CAPITAL LETTER CHI
  (#xD8 #x03A8) ; GREEK CAPITAL LETTER PSI
  (#xD9 #x03A9) ; GREEK CAPITAL LETTER OMEGA
  (#xDA #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
  (#xDB #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
  (#xDC #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
  (#xDD #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
  (#xDE #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
  (#xDF #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
  (#xE0 #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
  (#xE1 #x03B1) ; GREEK SMALL LETTER ALPHA
  (#xE2 #x03B2) ; GREEK SMALL LETTER BETA
  (#xE3 #x03B3) ; GREEK SMALL LETTER GAMMA
  (#xE4 #x03B4) ; GREEK SMALL LETTER DELTA
  (#xE5 #x03B5) ; GREEK SMALL LETTER EPSILON
  (#xE6 #x03B6) ; GREEK SMALL LETTER ZETA
  (#xE7 #x03B7) ; GREEK SMALL LETTER ETA
  (#xE8 #x03B8) ; GREEK SMALL LETTER THETA
  (#xE9 #x03B9) ; GREEK SMALL LETTER IOTA
  (#xEA #x03BA) ; GREEK SMALL LETTER KAPPA
  (#xEB #x03BB) ; GREEK SMALL LETTER LAMDA
  (#xEC #x03BC) ; GREEK SMALL LETTER MU
  (#xED #x03BD) ; GREEK SMALL LETTER NU
  (#xEE #x03BE) ; GREEK SMALL LETTER XI
  (#xEF #x03BF) ; GREEK SMALL LETTER OMICRON
  (#xF0 #x03C0) ; GREEK SMALL LETTER PI
  (#xF1 #x03C1) ; GREEK SMALL LETTER RHO
  (#xF2 #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
  (#xF3 #x03C3) ; GREEK SMALL LETTER SIGMA
  (#xF4 #x03C4) ; GREEK SMALL LETTER TAU
  (#xF5 #x03C5) ; GREEK SMALL LETTER UPSILON
  (#xF6 #x03C6) ; GREEK SMALL LETTER PHI
  (#xF7 #x03C7) ; GREEK SMALL LETTER CHI
  (#xF8 #x03C8) ; GREEK SMALL LETTER PSI
  (#xF9 #x03C9) ; GREEK SMALL LETTER OMEGA
  (#xFA #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
  (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
  (#xFC #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
  (#xFD #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
  (#xFE #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
  (#xFF nil)
)

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

(defun string->cp1253 (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-cp1253-bytes null-padding)))

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

(instantiate-octets-definition define-cp1253->string*)

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

(instantiate-octets-definition define-cp1253->string)

(add-external-format-funs '(:cp1253 :|cp1253| :windows-1253 :|windows-1253|)
                          '(cp1253->string-aref string->cp1253))

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

(define-unibyte-mapper cp1254->code-mapper code->cp1254-mapper
  (#x80 #x20AC) ; EURO SIGN
  (#x81 nil)
  (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
  (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
  (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
  (#x85 #x2026) ; HORIZONTAL ELLIPSIS
  (#x86 #x2020) ; DAGGER
  (#x87 #x2021) ; DOUBLE DAGGER
  (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
  (#x89 #x2030) ; PER MILLE SIGN
  (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
  (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
  (#x8D nil)
  (#x8E nil)
  (#x8F nil)
  (#x90 nil)
  (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
  (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
  (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
  (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  (#x95 #x2022) ; BULLET
  (#x96 #x2013) ; EN DASH
  (#x97 #x2014) ; EM DASH
  (#x98 #x02DC) ; SMALL TILDE
  (#x99 #x2122) ; TRADE MARK SIGN
  (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
  (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
  (#x9C #x0153) ; LATIN SMALL LIGATURE OE
  (#x9D nil)
  (#x9E nil)
  (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
  (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
  (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
  (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
  (#xF0 #x011F) ; LATIN SMALL LETTER G WITH BREVE
  (#xFD #x0131) ; LATIN SMALL LETTER DOTLESS I
  (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
)

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

(defun string->cp1254 (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-cp1254-bytes null-padding)))

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

(instantiate-octets-definition define-cp1254->string*)

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

(instantiate-octets-definition define-cp1254->string)

(add-external-format-funs '(:cp1254 :|cp1254| :windows-1254 :|windows-1254|)
                          '(cp1254->string-aref string->cp1254))

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

(define-unibyte-mapper cp1255->code-mapper code->cp1255-mapper
  (#x80 #x20AC) ; EURO SIGN
  (#x81 nil)
  (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
  (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
  (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
  (#x85 #x2026) ; HORIZONTAL ELLIPSIS
  (#x86 #x2020) ; DAGGER
  (#x87 #x2021) ; DOUBLE DAGGER
  (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
  (#x89 #x2030) ; PER MILLE SIGN
  (#x8A nil)
  (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
  (#x8C nil)
  (#x8D nil)
  (#x8E nil)
  (#x8F nil)
  (#x90 nil)
  (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
  (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
  (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
  (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  (#x95 #x2022) ; BULLET
  (#x96 #x2013) ; EN DASH
  (#x97 #x2014) ; EM DASH
  (#x98 #x02DC) ; SMALL TILDE
  (#x99 #x2122) ; TRADE MARK SIGN
  (#x9A nil)
  (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
  (#x9C nil)
  (#x9D nil)
  (#x9E nil)
  (#x9F nil)
  (#xA4 #x20AA) ; NEW SHEQEL SIGN
  (#xAA #x00D7) ; MULTIPLICATION SIGN
  (#xBA #x00F7) ; DIVISION SIGN
  (#xC0 #x05B0) ; HEBREW POINT SHEVA
  (#xC1 #x05B1) ; HEBREW POINT HATAF SEGOL
  (#xC2 #x05B2) ; HEBREW POINT HATAF PATAH
  (#xC3 #x05B3) ; HEBREW POINT HATAF QAMATS
  (#xC4 #x05B4) ; HEBREW POINT HIRIQ
  (#xC5 #x05B5) ; HEBREW POINT TSERE
  (#xC6 #x05B6) ; HEBREW POINT SEGOL
  (#xC7 #x05B7) ; HEBREW POINT PATAH
  (#xC8 #x05B8) ; HEBREW POINT QAMATS
  (#xC9 #x05B9) ; HEBREW POINT HOLAM
  (#xCA nil)
  (#xCB #x05BB) ; HEBREW POINT QUBUTS
  (#xCC #x05BC) ; HEBREW POINT DAGESH OR MAPIQ
  (#xCD #x05BD) ; HEBREW POINT METEG
  (#xCE #x05BE) ; HEBREW PUNCTUATION MAQAF
  (#xCF #x05BF) ; HEBREW POINT RAFE
  (#xD0 #x05C0) ; HEBREW PUNCTUATION PASEQ
  (#xD1 #x05C1) ; HEBREW POINT SHIN DOT
  (#xD2 #x05C2) ; HEBREW POINT SIN DOT
  (#xD3 #x05C3) ; HEBREW PUNCTUATION SOF PASUQ
  (#xD4 #x05F0) ; HEBREW LIGATURE YIDDISH DOUBLE VAV
  (#xD5 #x05F1) ; HEBREW LIGATURE YIDDISH VAV YOD
  (#xD6 #x05F2) ; HEBREW LIGATURE YIDDISH DOUBLE YOD
  (#xD7 #x05F3) ; HEBREW PUNCTUATION GERESH
  (#xD8 #x05F4) ; HEBREW PUNCTUATION GERSHAYIM
  (#xD9 nil)
  (#xDA nil)
  (#xDB nil)
  (#xDC nil)
  (#xDD nil)
  (#xDE nil)
  (#xDF nil)
  (#xE0 #x05D0) ; HEBREW LETTER ALEF
  (#xE1 #x05D1) ; HEBREW LETTER BET
  (#xE2 #x05D2) ; HEBREW LETTER GIMEL
  (#xE3 #x05D3) ; HEBREW LETTER DALET
  (#xE4 #x05D4) ; HEBREW LETTER HE
  (#xE5 #x05D5) ; HEBREW LETTER VAV
  (#xE6 #x05D6) ; HEBREW LETTER ZAYIN
  (#xE7 #x05D7) ; HEBREW LETTER HET
  (#xE8 #x05D8) ; HEBREW LETTER TET
  (#xE9 #x05D9) ; HEBREW LETTER YOD
  (#xEA #x05DA) ; HEBREW LETTER FINAL KAF
  (#xEB #x05DB) ; HEBREW LETTER KAF
  (#xEC #x05DC) ; HEBREW LETTER LAMED
  (#xED #x05DD) ; HEBREW LETTER FINAL MEM
  (#xEE #x05DE) ; HEBREW LETTER MEM
  (#xEF #x05DF) ; HEBREW LETTER FINAL NUN
  (#xF0 #x05E0) ; HEBREW LETTER NUN
  (#xF1 #x05E1) ; HEBREW LETTER SAMEKH
  (#xF2 #x05E2) ; HEBREW LETTER AYIN
  (#xF3 #x05E3) ; HEBREW LETTER FINAL PE
  (#xF4 #x05E4) ; HEBREW LETTER PE
  (#xF5 #x05E5) ; HEBREW LETTER FINAL TSADI
  (#xF6 #x05E6) ; HEBREW LETTER TSADI
  (#xF7 #x05E7) ; HEBREW LETTER QOF
  (#xF8 #x05E8) ; HEBREW LETTER RESH
  (#xF9 #x05E9) ; HEBREW LETTER SHIN
  (#xFA #x05EA) ; HEBREW LETTER TAV
  (#xFB nil)
  (#xFC nil)
  (#xFD #x200E) ; LEFT-TO-RIGHT MARK
  (#xFE #x200F) ; RIGHT-TO-LEFT MARK
  (#xFF nil)
)

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

(defun string->cp1255 (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-cp1255-bytes null-padding)))

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

(instantiate-octets-definition define-cp1255->string*)

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

(instantiate-octets-definition define-cp1255->string)

(add-external-format-funs '(:cp1255 :|cp1255| :windows-1255 :|windows-1255|)
                          '(cp1255->string-aref string->cp1255))

(define-external-format (:cp1255 :|cp1255| :windows-1255 :|windows-1255|)