0.9.13.30
[sbcl.git] / src / code / external-formats / enc-win.lisp
index b223f01..3053734 100644 (file)
@@ -87,7 +87,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1250 string pos end))
+  (get-latin-bytes #'code->cp1250-mapper :cp1250 string pos end))
 
 (defun string->cp1250 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1250->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 #'cp1250->code-mapper)))))
 
 (instantiate-octets-definition define-cp1250->string*)
 
 (defmacro define-cp1250->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1250->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1250->code-mapper)))
 
 (instantiate-octets-definition define-cp1250->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1251 string pos end))
+  (get-latin-bytes #'code->cp1251-mapper :cp1251 string pos end))
 
 (defun string->cp1251 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1251->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 #'cp1251->code-mapper)))))
 
 (instantiate-octets-definition define-cp1251->string*)
 
 (defmacro define-cp1251->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1251->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1251->code-mapper)))
 
 (instantiate-octets-definition define-cp1251->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1252 string pos end))
+  (get-latin-bytes #'code->cp1252-mapper :cp1252 string pos end))
 
 (defun string->cp1252 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1252->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 #'cp1252->code-mapper)))))
 
 (instantiate-octets-definition define-cp1252->string*)
 
 (defmacro define-cp1252->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1252->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1252->code-mapper)))
 
 (instantiate-octets-definition define-cp1252->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1253 string pos end))
+  (get-latin-bytes #'code->cp1253-mapper :cp1253 string pos end))
 
 (defun string->cp1253 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (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 #'identity)))))
+        (,(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 #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1253->code-mapper)))
 
 (instantiate-octets-definition define-cp1253->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1254 string pos end))
+  (get-latin-bytes #'code->cp1254-mapper :cp1254 string pos end))
 
 (defun string->cp1254 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (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 #'identity)))))
+        (,(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 #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1254->code-mapper)))
 
 (instantiate-octets-definition define-cp1254->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1255 string pos end))
+  (get-latin-bytes #'code->cp1255-mapper :cp1255 string pos end))
 
 (defun string->cp1255 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (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 #'identity)))))
+        (,(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 #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1255->code-mapper)))
 
 (instantiate-octets-definition define-cp1255->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1256 string pos end))
+  (get-latin-bytes #'code->cp1256-mapper :cp1256 string pos end))
 
 (defun string->cp1256 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1256->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 #'cp1256->code-mapper)))))
 
 (instantiate-octets-definition define-cp1256->string*)
 
 (defmacro define-cp1256->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1256->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1256->code-mapper)))
 
 (instantiate-octets-definition define-cp1256->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1257 string pos end))
+  (get-latin-bytes #'code->cp1257-mapper :cp1257 string pos end))
 
 (defun string->cp1257 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1257->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 #'cp1257->code-mapper)))))
 
 (instantiate-octets-definition define-cp1257->string*)
 
 (defmacro define-cp1257->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1257->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1257->code-mapper)))
 
 (instantiate-octets-definition define-cp1257->string)
 
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1258 string pos end))
+  (get-latin-bytes #'code->cp1258-mapper :cp1258 string pos end))
 
 (defun string->cp1258 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
   (let ((name (make-od-name 'cp1258->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 #'cp1258->code-mapper)))))
 
 (instantiate-octets-definition define-cp1258->string*)
 
 (defmacro define-cp1258->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1258->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1258->code-mapper)))
 
 (instantiate-octets-definition define-cp1258->string)