X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-iso.lisp;h=b5bdadb575ee5ada7bbe611b8902b246a31adbdd;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=f8a1119b6490b8e4f521c4876eeb614a664f97a5;hpb=54b330585ed41edeb93a289f0e59aec67fa9ded9;p=sbcl.git diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index f8a1119..b5bdadb 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -1,6 +1,7 @@ -(in-package #:sb!impl) +(in-package "SB!IMPL") -(define-unibyte-mapper iso-8859-2->code-mapper code->iso-8859-2-mapper +(define-unibyte-mapping-external-format :iso-8859-2 + (:|iso-8859-2| :latin-2 :|latin-2|) (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK (#xA2 #x02D8) ; BREVE (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE @@ -60,51 +61,8 @@ (#xFF #x02D9) ; DOT ABOVE ) -(declaim (inline get-iso-8859-2-bytes)) -(defun get-iso-8859-2-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos end)) - -(defun string->iso-8859-2 (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-2-bytes null-padding))) - -(defmacro define-iso-8859-2->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-2->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-2->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-2->string*) - -(defmacro define-iso-8859-2->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-2->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-2->code-mapper))) - -(instantiate-octets-definition define-iso-8859-2->string) - -(push '((:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|) - iso-8859-2->string-aref string->iso-8859-2) - *external-format-functions*) - -(define-external-format (:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|) - 1 t - (let ((iso-8859-2-byte (code->iso-8859-2-mapper bits))) - (if iso-8859-2-byte - (setf (sap-ref-8 sap tail) iso-8859-2-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-2->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-3->code-mapper code->iso-8859-3-mapper +(define-unibyte-mapping-external-format :iso-8859-3 + (:|iso-8859-3| :latin-3 :|latin-3|) (#xA1 #x0126) ; LATIN CAPITAL LETTER H WITH STROKE (#xA2 #x02D8) ; BREVE (#xA5 nil) @@ -142,51 +100,8 @@ (#xFF #x02D9) ; DOT ABOVE ) -(declaim (inline get-iso-8859-3-bytes)) -(defun get-iso-8859-3-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos end)) - -(defun string->iso-8859-3 (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-3-bytes null-padding))) - -(defmacro define-iso-8859-3->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-3->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-3->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-3->string*) - -(defmacro define-iso-8859-3->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-3->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-3->code-mapper))) - -(instantiate-octets-definition define-iso-8859-3->string) - -(push '((:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|) - iso-8859-3->string-aref string->iso-8859-3) - *external-format-functions*) - -(define-external-format (:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|) - 1 t - (let ((iso-8859-3-byte (code->iso-8859-3-mapper bits))) - (if iso-8859-3-byte - (setf (sap-ref-8 sap tail) iso-8859-3-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-3->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-4->code-mapper code->iso-8859-4-mapper +(define-unibyte-mapping-external-format :iso-8859-4 + (:|iso-8859-4| :latin-4 :|latin-4|) (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK (#xA2 #x0138) ; LATIN SMALL LETTER KRA (#xA3 #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA @@ -239,51 +154,7 @@ (#xFF #x02D9) ; DOT ABOVE ) -(declaim (inline get-iso-8859-4-bytes)) -(defun get-iso-8859-4-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos end)) - -(defun string->iso-8859-4 (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-4-bytes null-padding))) - -(defmacro define-iso-8859-4->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-4->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-4->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-4->string*) - -(defmacro define-iso-8859-4->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-4->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-4->code-mapper))) - -(instantiate-octets-definition define-iso-8859-4->string) - -(push '((:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|) - iso-8859-4->string-aref string->iso-8859-4) - *external-format-functions*) - -(define-external-format (:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|) - 1 t - (let ((iso-8859-4-byte (code->iso-8859-4-mapper bits))) - (if iso-8859-4-byte - (setf (sap-ref-8 sap tail) iso-8859-4-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-4->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-5->code-mapper code->iso-8859-5-mapper +(define-unibyte-mapping-external-format :iso-8859-5 (:|iso-8859-5|) (#xA1 #x0401) ; CYRILLIC CAPITAL LETTER IO (#xA2 #x0402) ; CYRILLIC CAPITAL LETTER DJE (#xA3 #x0403) ; CYRILLIC CAPITAL LETTER GJE @@ -380,51 +251,7 @@ (#xFF #x045F) ; CYRILLIC SMALL LETTER DZHE ) -(declaim (inline get-iso-8859-5-bytes)) -(defun get-iso-8859-5-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos end)) - -(defun string->iso-8859-5 (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-5-bytes null-padding))) - -(defmacro define-iso-8859-5->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-5->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-5->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-5->string*) - -(defmacro define-iso-8859-5->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-5->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-5->code-mapper))) - -(instantiate-octets-definition define-iso-8859-5->string) - -(push '((:iso-8859-5 :|iso-8859-5|) - iso-8859-5->string-aref string->iso-8859-5) - *external-format-functions*) - -(define-external-format (:iso-8859-5 :|iso-8859-5|) - 1 t - (let ((iso-8859-5-byte (code->iso-8859-5-mapper bits))) - (if iso-8859-5-byte - (setf (sap-ref-8 sap tail) iso-8859-5-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-5->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-6->code-mapper code->iso-8859-6-mapper +(define-unibyte-mapping-external-format :iso-8859-6 (:|iso-8859-6|) (#xA1 nil) (#xA2 nil) (#xA3 nil) @@ -520,51 +347,7 @@ (#xFF nil) ) -(declaim (inline get-iso-8859-6-bytes)) -(defun get-iso-8859-6-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos end)) - -(defun string->iso-8859-6 (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-6-bytes null-padding))) - -(defmacro define-iso-8859-6->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-6->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-6->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-6->string*) - -(defmacro define-iso-8859-6->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-6->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-6->code-mapper))) - -(instantiate-octets-definition define-iso-8859-6->string) - -(push '((:iso-8859-6 :|iso-8859-6|) - iso-8859-6->string-aref string->iso-8859-6) - *external-format-functions*) - -(define-external-format (:iso-8859-6 :|iso-8859-6|) - 1 t - (let ((iso-8859-6-byte (code->iso-8859-6-mapper bits))) - (if iso-8859-6-byte - (setf (sap-ref-8 sap tail) iso-8859-6-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-6->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-7->code-mapper code->iso-8859-7-mapper +(define-unibyte-mapping-external-format :iso-8859-7 (:|iso-8859-7|) (#xA1 #x02BD) ; MODIFIER LETTER REVERSED COMMA (#xA2 #x02BC) ; MODIFIER LETTER APOSTROPHE (#xA4 nil) @@ -647,51 +430,7 @@ (#xFF nil) ) -(declaim (inline get-iso-8859-7-bytes)) -(defun get-iso-8859-7-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos end)) - -(defun string->iso-8859-7 (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-7-bytes null-padding))) - -(defmacro define-iso-8859-7->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-7->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-7->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-7->string*) - -(defmacro define-iso-8859-7->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-7->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-7->code-mapper))) - -(instantiate-octets-definition define-iso-8859-7->string) - -(push '((:iso-8859-7 :|iso-8859-7|) - iso-8859-7->string-aref string->iso-8859-7) - *external-format-functions*) - -(define-external-format (:iso-8859-7 :|iso-8859-7|) - 1 t - (let ((iso-8859-7-byte (code->iso-8859-7-mapper bits))) - (if iso-8859-7-byte - (setf (sap-ref-8 sap tail) iso-8859-7-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-7->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-8->code-mapper code->iso-8859-8-mapper +(define-unibyte-mapping-external-format :iso-8859-8 (:|iso-8859-8|) (#xA1 nil) (#xAA #x00D7) ; MULTIPLICATION SIGN (#xAF #x203E) ; OVERLINE @@ -763,51 +502,8 @@ (#xFF nil) ) -(declaim (inline get-iso-8859-8-bytes)) -(defun get-iso-8859-8-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos end)) - -(defun string->iso-8859-8 (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-8-bytes null-padding))) - -(defmacro define-iso-8859-8->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-8->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-8->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-8->string*) - -(defmacro define-iso-8859-8->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-8->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-8->code-mapper))) - -(instantiate-octets-definition define-iso-8859-8->string) - -(push '((:iso-8859-8 :|iso-8859-8|) - iso-8859-8->string-aref string->iso-8859-8) - *external-format-functions*) - -(define-external-format (:iso-8859-8 :|iso-8859-8|) - 1 t - (let ((iso-8859-8-byte (code->iso-8859-8-mapper bits))) - (if iso-8859-8-byte - (setf (sap-ref-8 sap tail) iso-8859-8-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-8->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-9->code-mapper code->iso-8859-9-mapper +(define-unibyte-mapping-external-format :iso-8859-9 + (:|iso-8859-9| :latin-5 :|latin-5|) (#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 @@ -816,51 +512,8 @@ (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA ) -(declaim (inline get-iso-8859-9-bytes)) -(defun get-iso-8859-9-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos end)) - -(defun string->iso-8859-9 (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-9-bytes null-padding))) - -(defmacro define-iso-8859-9->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-9->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-9->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-9->string*) - -(defmacro define-iso-8859-9->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-9->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-9->code-mapper))) - -(instantiate-octets-definition define-iso-8859-9->string) - -(push '((:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|) - iso-8859-9->string-aref string->iso-8859-9) - *external-format-functions*) - -(define-external-format (:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|) - 1 t - (let ((iso-8859-9-byte (code->iso-8859-9-mapper bits))) - (if iso-8859-9-byte - (setf (sap-ref-8 sap tail) iso-8859-9-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-9->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-10->code-mapper code->iso-8859-10-mapper +(define-unibyte-mapping-external-format :iso-8859-10 + (:|iso-8859-10| :latin-6 :|latin-6|) (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK (#xA2 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON (#xA3 #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA @@ -909,51 +562,7 @@ (#xFF #x0138) ; LATIN SMALL LETTER KRA ) -(declaim (inline get-iso-8859-10-bytes)) -(defun get-iso-8859-10-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos end)) - -(defun string->iso-8859-10 (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-10-bytes null-padding))) - -(defmacro define-iso-8859-10->string* (accessor type) - (declare (ignore type)) - (let ((name (make-od-name 'iso-8859-10->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-10->code-mapper))))) - -(instantiate-octets-definition define-iso-8859-10->string*) - -(defmacro define-iso-8859-10->string (accessor type) - (declare (ignore type)) - `(defun ,(make-od-name 'iso-8859-10->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-10->code-mapper))) - -(instantiate-octets-definition define-iso-8859-10->string) - -(push '((:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|) - iso-8859-10->string-aref string->iso-8859-10) - *external-format-functions*) - -(define-external-format (:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|) - 1 t - (let ((iso-8859-10-byte (code->iso-8859-10-mapper bits))) - (if iso-8859-10-byte - (setf (sap-ref-8 sap tail) iso-8859-10-byte) - (external-format-encoding-error stream bits))) - (let ((code (iso-8859-10->code-mapper byte))) - (if code - (code-char code) - (external-format-decoding-error stream byte)))) ;; TODO -- error check - -(define-unibyte-mapper iso-8859-11->code-mapper code->iso-8859-11-mapper +(define-unibyte-mapping-external-format :iso-8859-11 (:|iso-8859-11|) (#xA1 #x0E01) ; THAI CHARACTER KO KAI (#xA2 #x0E02) ; THAI CHARACTER KHO KHAI (#xA3 #x0E03) ; THAI CHARACTER KHO KHUAT @@ -1051,51 +660,8 @@ (#xFF nil) ) -(declaim (inline get-iso-8859-11-bytes)) -(defun get-iso-8859-11-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos end)) - -(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) - -(push '((:iso-8859-11 :|iso-8859-11|) - iso-8859-11->string-aref string->iso-8859-11) - *external-format-functions*) - -(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 +(define-unibyte-mapping-external-format :iso-8859-13 + (:|iso-8859-13| :latin-7 :|latin-7|) (#xA1 #x201D) ; RIGHT DOUBLE QUOTATION MARK (#xA5 #x201E) ; DOUBLE LOW-9 QUOTATION MARK (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE @@ -1154,51 +720,8 @@ (#xFF #x2019) ; RIGHT SINGLE QUOTATION MARK ) -(declaim (inline get-iso-8859-13-bytes)) -(defun get-iso-8859-13-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos end)) - -(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) - -(push '((:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|) - iso-8859-13->string-aref string->iso-8859-13) - *external-format-functions*) - -(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 +(define-unibyte-mapping-external-format :iso-8859-14 + (:|iso-8859-14| :latin-8 :|latin-8|) (#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 @@ -1232,46 +755,15 @@ (#xFE #x0177) ; LATIN SMALL LETTER Y WITH CIRCUMFLEX ) -(declaim (inline get-iso-8859-14-bytes)) -(defun get-iso-8859-14-bytes(string pos end) - (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'code->iso-8859-14-mapper :iso-8859-14 string pos end)) - -(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) - -(push '((:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|) - iso-8859-14->string-aref string->iso-8859-14) - *external-format-functions*) - -(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 +;;; The names for latin9 are different due to a historical accident. +(define-unibyte-mapping-external-format :latin-9 + (:latin9 :iso-8859-15 :iso8859-15) + (#xA4 #x20AC) + (#xA6 #x0160) + (#xA8 #x0161) + (#xB4 #x017D) + (#xB8 #x017E) + (#xBC #x0152) + (#xBD #x0153) + (#xBE #x0178) +)