X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-iso.lisp;h=a6f446c90be42dd3ecdfe9c2f76ab74333c3982b;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=4c6036846b2a39e9c1be2a34593cb376a080ff22;hpb=b3e3fbe7d381147fccc8a3027cb6fae923e57d13;p=sbcl.git diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index 4c60368..a6f446c 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -1,4 +1,4 @@ -(in-package #:sb!impl) +(in-package "SB!IMPL") (define-unibyte-mapper iso-8859-2->code-mapper code->iso-8859-2-mapper (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK @@ -61,11 +61,11 @@ ) (declaim (inline get-iso-8859-2-bytes)) -(defun get-iso-8859-2-bytes(string pos end) +(defun get-iso-8859-2-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-2 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos)) (defun string->iso-8859-2 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -78,31 +78,30 @@ (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) -(push '((:iso-8859-2 :|iso-8859-2|) - iso-8859-2->string-aref string->iso-8859-2) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|) + '(iso-8859-2->string-aref string->iso-8859-2)) -(define-external-format (:iso-8859-2 :|iso-8859-2|) +(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) - (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 @@ -143,11 +142,11 @@ ) (declaim (inline get-iso-8859-3-bytes)) -(defun get-iso-8859-3-bytes(string pos end) +(defun get-iso-8859-3-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-3 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos)) (defun string->iso-8859-3 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -160,31 +159,30 @@ (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) -(push '((:iso-8859-3 :|iso-8859-3|) - iso-8859-3->string-aref string->iso-8859-3) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|) + '(iso-8859-3->string-aref string->iso-8859-3)) -(define-external-format (:iso-8859-3 :|iso-8859-3|) +(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) - (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 @@ -240,11 +238,11 @@ ) (declaim (inline get-iso-8859-4-bytes)) -(defun get-iso-8859-4-bytes(string pos end) +(defun get-iso-8859-4-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-4 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos)) (defun string->iso-8859-4 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -257,31 +255,30 @@ (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) -(push '((:iso-8859-4 :|iso-8859-4|) - iso-8859-4->string-aref string->iso-8859-4) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|) + '(iso-8859-4->string-aref string->iso-8859-4)) -(define-external-format (:iso-8859-4 :|iso-8859-4|) +(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) - (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 @@ -381,11 +378,11 @@ ) (declaim (inline get-iso-8859-5-bytes)) -(defun get-iso-8859-5-bytes(string pos end) +(defun get-iso-8859-5-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-5 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos)) (defun string->iso-8859-5 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -398,31 +395,30 @@ (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) -(push '((:iso-8859-5 :|iso-8859-5|) - iso-8859-5->string-aref string->iso-8859-5) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-5 :|iso-8859-5|) + '(iso-8859-5->string-aref string->iso-8859-5)) (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) - (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) @@ -521,11 +517,11 @@ ) (declaim (inline get-iso-8859-6-bytes)) -(defun get-iso-8859-6-bytes(string pos end) +(defun get-iso-8859-6-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-6 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos)) (defun string->iso-8859-6 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -538,31 +534,30 @@ (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) -(push '((:iso-8859-6 :|iso-8859-6|) - iso-8859-6->string-aref string->iso-8859-6) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-6 :|iso-8859-6|) + '(iso-8859-6->string-aref string->iso-8859-6)) (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) - (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 @@ -648,11 +643,11 @@ ) (declaim (inline get-iso-8859-7-bytes)) -(defun get-iso-8859-7-bytes(string pos end) +(defun get-iso-8859-7-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-7 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos)) (defun string->iso-8859-7 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -665,31 +660,30 @@ (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) -(push '((:iso-8859-7 :|iso-8859-7|) - iso-8859-7->string-aref string->iso-8859-7) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-7 :|iso-8859-7|) + '(iso-8859-7->string-aref string->iso-8859-7)) (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) - (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) @@ -764,11 +758,11 @@ ) (declaim (inline get-iso-8859-8-bytes)) -(defun get-iso-8859-8-bytes(string pos end) +(defun get-iso-8859-8-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-8 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos)) (defun string->iso-8859-8 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -781,31 +775,30 @@ (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) -(push '((:iso-8859-8 :|iso-8859-8|) - iso-8859-8->string-aref string->iso-8859-8) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-8 :|iso-8859-8|) + '(iso-8859-8->string-aref string->iso-8859-8)) (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) - (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 @@ -817,11 +810,11 @@ ) (declaim (inline get-iso-8859-9-bytes)) -(defun get-iso-8859-9-bytes(string pos end) +(defun get-iso-8859-9-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-9 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos)) (defun string->iso-8859-9 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -834,31 +827,30 @@ (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) -(push '((:iso-8859-9 :|iso-8859-9|) - iso-8859-9->string-aref string->iso-8859-9) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|) + '(iso-8859-9->string-aref string->iso-8859-9)) -(define-external-format (:iso-8859-9 :|iso-8859-9|) +(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) - (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 @@ -910,11 +902,11 @@ ) (declaim (inline get-iso-8859-10-bytes)) -(defun get-iso-8859-10-bytes(string pos end) +(defun get-iso-8859-10-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-10 string pos end)) + (type array-range pos)) + (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos)) (defun string->iso-8859-10 (string sstart send null-padding) (declare (optimize speed (safety 0)) @@ -927,31 +919,30 @@ (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) -(push '((:iso-8859-10 :|iso-8859-10|) - iso-8859-10->string-aref string->iso-8859-10) - *external-format-functions*) +(add-external-format-funs '(:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|) + '(iso-8859-10->string-aref string->iso-8859-10)) -(define-external-format (:iso-8859-10 :|iso-8859-10|) +(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) - (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 @@ -1052,11 +1043,11 @@ ) (declaim (inline get-iso-8859-11-bytes)) -(defun get-iso-8859-11-bytes(string pos end) +(defun get-iso-8859-11-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-11 string pos end)) + (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)) @@ -1069,31 +1060,30 @@ (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) -(push '((:iso-8859-11 :|iso-8859-11|) - iso-8859-11->string-aref string->iso-8859-11) - *external-format-functions*) +(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) - (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 @@ -1155,11 +1145,11 @@ ) (declaim (inline get-iso-8859-13-bytes)) -(defun get-iso-8859-13-bytes(string pos end) +(defun get-iso-8859-13-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-13 string pos end)) + (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)) @@ -1172,31 +1162,30 @@ (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) -(push '((:iso-8859-13 :|iso-8859-13|) - iso-8859-13->string-aref string->iso-8859-13) - *external-format-functions*) +(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|) +(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) - (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 @@ -1233,11 +1222,11 @@ ) (declaim (inline get-iso-8859-14-bytes)) -(defun get-iso-8859-14-bytes(string pos end) +(defun get-iso-8859-14-bytes (string pos) (declare (optimize speed (safety 0)) (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-14 string pos end)) + (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)) @@ -1250,28 +1239,27 @@ (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) -(push '((:iso-8859-14 :|iso-8859-14|) - iso-8859-14->string-aref string->iso-8859-14) - *external-format-functions*) +(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|) +(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) - (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