X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-iso.lisp;h=f8a1119b6490b8e4f521c4876eeb614a664f97a5;hb=d10b036b1d20e6cff820f72b69af2a06dc362327;hp=f246aee9f2ccd1b6530cbd867065d706dfbe407f;hpb=3dfa1bf99afb2206901b73e6c8d143db8c6a8b11;p=sbcl.git diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index f246aee..f8a1119 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -65,7 +65,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-2 string 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)) @@ -78,14 +78,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-2->code-mapper))) (instantiate-octets-definition define-iso-8859-2->string) @@ -98,11 +98,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-2->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-3->code-mapper code->iso-8859-3-mapper (#xA1 #x0126) ; LATIN CAPITAL LETTER H WITH STROKE @@ -147,7 +147,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-3 string 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)) @@ -160,14 +160,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-3->code-mapper))) (instantiate-octets-definition define-iso-8859-3->string) @@ -180,11 +180,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-3->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-4->code-mapper code->iso-8859-4-mapper (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK @@ -244,7 +244,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-4 string 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)) @@ -257,14 +257,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-4->code-mapper))) (instantiate-octets-definition define-iso-8859-4->string) @@ -277,11 +277,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-4->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-5->code-mapper code->iso-8859-5-mapper (#xA1 #x0401) ; CYRILLIC CAPITAL LETTER IO @@ -385,7 +385,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-5 string 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)) @@ -398,14 +398,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-5->code-mapper))) (instantiate-octets-definition define-iso-8859-5->string) @@ -418,11 +418,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-5->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-6->code-mapper code->iso-8859-6-mapper (#xA1 nil) @@ -525,7 +525,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-6 string 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)) @@ -538,14 +538,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-6->code-mapper))) (instantiate-octets-definition define-iso-8859-6->string) @@ -558,11 +558,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-6->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-7->code-mapper code->iso-8859-7-mapper (#xA1 #x02BD) ; MODIFIER LETTER REVERSED COMMA @@ -652,7 +652,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-7 string 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)) @@ -665,14 +665,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-7->code-mapper))) (instantiate-octets-definition define-iso-8859-7->string) @@ -685,11 +685,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-7->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-8->code-mapper code->iso-8859-8-mapper (#xA1 nil) @@ -768,7 +768,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-8 string 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)) @@ -781,14 +781,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-8->code-mapper))) (instantiate-octets-definition define-iso-8859-8->string) @@ -801,11 +801,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-8->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-9->code-mapper code->iso-8859-9-mapper (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE @@ -821,7 +821,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-9 string 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)) @@ -834,14 +834,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-9->code-mapper))) (instantiate-octets-definition define-iso-8859-9->string) @@ -854,11 +854,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-9->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-10->code-mapper code->iso-8859-10-mapper (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK @@ -914,7 +914,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-10 string 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)) @@ -927,14 +927,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-10->code-mapper))) (instantiate-octets-definition define-iso-8859-10->string) @@ -947,11 +947,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-10->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check (define-unibyte-mapper iso-8859-11->code-mapper code->iso-8859-11-mapper (#xA1 #x0E01) ; THAI CHARACTER KO KAI @@ -1056,7 +1056,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-11 string 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)) @@ -1069,14 +1069,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-11->code-mapper))) (instantiate-octets-definition define-iso-8859-11->string) @@ -1089,11 +1089,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-11->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (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 @@ -1159,7 +1159,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-13 string 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)) @@ -1172,14 +1172,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-13->code-mapper))) (instantiate-octets-definition define-iso-8859-13->string) @@ -1192,11 +1192,11 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-13->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (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 @@ -1237,7 +1237,7 @@ (declare (optimize speed (safety 0)) (type simple-string string) (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-14 string 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)) @@ -1250,14 +1250,14 @@ (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 #'identity))))) + (,(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 #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-14->code-mapper))) (instantiate-octets-definition define-iso-8859-14->string) @@ -1270,8 +1270,8 @@ (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) - (stream-encoding-error-and-handle stream bits))) + (external-format-encoding-error stream bits))) (let ((code (iso-8859-14->code-mapper byte))) (if code (code-char code) - (stream-decoding-error stream byte)))) ;; TODO -- error check + (external-format-decoding-error stream byte)))) ;; TODO -- error check