1.0.18.8: Sort results of APROPOS-LIST and APROPOS.
[sbcl.git] / src / code / external-formats / enc-cyr.lisp
index 0cfa0e3..a0e033e 100644 (file)
@@ -1,4 +1,4 @@
-(in-package #:sb!impl)
+(in-package "SB!IMPL")
 
 (define-unibyte-mapper koi8-r->code-mapper code->koi8-r-mapper
   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 )
 
 (declaim (inline get-koi8-r-bytes))
-(defun get-koi8-r-bytes(string pos end)
+(defun get-koi8-r-bytes (string pos)
   (declare (optimize speed (safety 0))
            (type simple-string string)
-           (type array-range pos end))
-  (get-latin-bytes #'identity :koi8-r string pos end))
+           (type array-range pos))
+  (get-latin-bytes #'code->koi8-r-mapper :koi8-r string pos))
 
 (defun string->koi8-r (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'koi8-r->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 #'koi8-r->code-mapper)))))
 
 (instantiate-octets-definition define-koi8-r->string*)
 
 (defmacro define-koi8-r->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'koi8-r->code-mapper)))
 
 (instantiate-octets-definition define-koi8-r->string)
 
-(push '((:koi8-r :|koi8-r|)
-        koi8-r->string-aref string->koi8-r)
-      *external-format-functions*)
+(add-external-format-funs '(:koi8-r :|koi8-r|)
+                          '(koi8-r->string-aref string->koi8-r))
 
 (define-external-format (:koi8-r :|koi8-r|)
     1 t
     (let ((koi8-r-byte (code->koi8-r-mapper bits)))
       (if koi8-r-byte
           (setf (sap-ref-8 sap tail) koi8-r-byte)
-          (stream-encoding-error-and-handle stream bits)))
+          (external-format-encoding-error stream bits)))
     (let ((code (koi8-r->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 koi8-u->code-mapper code->koi8-u-mapper
   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 )
 
 (declaim (inline get-koi8-u-bytes))
-(defun get-koi8-u-bytes(string pos end)
+(defun get-koi8-u-bytes (string pos)
   (declare (optimize speed (safety 0))
            (type simple-string string)
-           (type array-range pos end))
-  (get-latin-bytes #'identity :koi8-u string pos end))
+           (type array-range pos))
+  (get-latin-bytes #'code->koi8-u-mapper :koi8-u string pos))
 
 (defun string->koi8-u (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'koi8-u->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 #'koi8-u->code-mapper)))))
 
 (instantiate-octets-definition define-koi8-u->string*)
 
 (defmacro define-koi8-u->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'koi8-u->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'koi8-u->code-mapper)))
 
 (instantiate-octets-definition define-koi8-u->string)
 
-(push '((:koi8-u :|koi8-u|)
-        koi8-u->string-aref string->koi8-u)
-      *external-format-functions*)
+(add-external-format-funs '(:koi8-u :|koi8-u|)
+                          '(koi8-u->string-aref string->koi8-u))
 
 (define-external-format (:koi8-u :|koi8-u|)
     1 t
     (let ((koi8-u-byte (code->koi8-u-mapper bits)))
       (if koi8-u-byte
           (setf (sap-ref-8 sap tail) koi8-u-byte)
-          (stream-encoding-error-and-handle stream bits)))
+          (external-format-encoding-error stream bits)))
     (let ((code (koi8-u->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 x-mac-cyrillic->code-mapper code->x-mac-cyrillic-mapper
   (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A
 )
 
 (declaim (inline get-x-mac-cyrillic-bytes))
-(defun get-x-mac-cyrillic-bytes(string pos end)
+(defun get-x-mac-cyrillic-bytes (string pos)
   (declare (optimize speed (safety 0))
            (type simple-string string)
-           (type array-range pos end))
-  (get-latin-bytes #'identity :x-mac-cyrillic string pos end))
+           (type array-range pos))
+  (get-latin-bytes #'code->x-mac-cyrillic-mapper :x-mac-cyrillic string pos))
 
 (defun string->x-mac-cyrillic (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'x-mac-cyrillic->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 #'x-mac-cyrillic->code-mapper)))))
 
 (instantiate-octets-definition define-x-mac-cyrillic->string*)
 
 (defmacro define-x-mac-cyrillic->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'x-mac-cyrillic->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'x-mac-cyrillic->code-mapper)))
 
 (instantiate-octets-definition define-x-mac-cyrillic->string)
 
-(push '((:x-mac-cyrillic :|x-mac-cyrillic|)
-        x-mac-cyrillic->string-aref string->x-mac-cyrillic)
-      *external-format-functions*)
+(add-external-format-funs '(:x-mac-cyrillic :|x-mac-cyrillic|)
+                          '(x-mac-cyrillic->string-aref string->x-mac-cyrillic))
 
 (define-external-format (:x-mac-cyrillic :|x-mac-cyrillic|)
     1 t
     (let ((x-mac-cyrillic-byte (code->x-mac-cyrillic-mapper bits)))
       (if x-mac-cyrillic-byte
           (setf (sap-ref-8 sap tail) x-mac-cyrillic-byte)
-          (stream-encoding-error-and-handle stream bits)))
+          (external-format-encoding-error stream bits)))
     (let ((code (x-mac-cyrillic->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