X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fi18n.lisp;h=a46b5354b01f43c331bb20e54d2c3d7434581363;hb=HEAD;hp=ca2c1b439f392b176012041e730bbc7dce339689;hpb=4440dd8df02fa22120c5c742989b1daa1fde84d4;p=uffi.git

diff --git a/src/i18n.lisp b/src/i18n.lisp
index ca2c1b4..a46b535 100644
--- a/src/i18n.lisp
+++ b/src/i18n.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -58,7 +58,7 @@ encoding.")
 (defun lookup-foreign-encoding (normalized)
   (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql)))
 
-(defmacro string-to-octets (str &key encoding)
+(defmacro string-to-octets (str &key encoding null-terminate)
   (declare (ignorable encoding))
   #-(or allegro lispworks openmcl sbcl)
   (map-into (make-array (length str) :element-type '(unsigned-byte 8))
@@ -67,31 +67,59 @@ encoding.")
   #+allegro
   (let ((fe (gensym "FE-"))
         (ife (gensym "IFE-"))
-        (s (gensym "STR-")))
+        (s (gensym "STR-"))
+        (nt (gensym "NT-")))
     `(let* ((,fe (or ,encoding *default-foreign-encoding*))
             (,ife (when ,fe (lookup-foreign-encoding ,fe)))
-            (,s ,str))
+            (,s ,str)
+            (,nt ,null-terminate))
        (values
         (if ,ife
-            (excl:string-to-octets ,s :external-format ,ife :null-terminate nil)
-            (excl:string-to-octets ,s :null-terminate nil)))))
-
-  #+(or lispworks openmcl)
+            (excl:string-to-octets ,s :external-format ,ife :null-terminate ,nt)
+            (excl:string-to-octets ,s :null-terminate ,nt)))))
+
+  #+ccl
+  ;; simply reading each char-code from the LENGTH of string handles
+  ;; multibyte characters in testing with CCL 1.5
+  (let ((len (gensym "LEN-"))
+        (out (gensym "OUT-")))
+    `(let ((,len (length ,str)))
+       (if (,null-terminate)
+           (progn
+             (let ((,out (map-into (make-array (1+ ,len) :element-type '(unsigned-byte 8))
+                                   #'char-code ,str)))
+               (setf (char ,out ,len) 0)
+               ,out))
+           (map-into (make-array len :element-type '(unsigned-byte 8))
+                     #'char-code str))))
+
+  #+lispworks
   ;; simply reading each char-code from the LENGTH of string handles multibyte characters
   ;; just fine in testing LW 6.0 and CCL 1.4
-  (map-into (make-array (length str) :element-type '(unsigned-byte 8))
-            #'char-code str)
+  (let ((len (gensym "LEN-"))
+        (out (gensym "OUT-")))
+    `(let ((,len (length ,str)))
+       (if (,null-terminate)
+           (progn
+             (let ((,out (map-into (make-array (1+ ,len) :element-type '(unsigned-byte 8))
+                                   #'char-code ,str)))
+               (setf (char ,out ,len) 0)
+               ,out))
+           (map-into (make-array len :element-type '(unsigned-byte 8))
+                     #'char-code str))))
 
   #+sbcl
   (let ((fe (gensym "FE-"))
         (ife (gensym "IFE-"))
-        (s (gensym "STR-")))
+        (s (gensym "STR-"))
+        (nt (gensym "NT-")))
     `(let* ((,fe (or ,encoding *default-foreign-encoding*))
             (,ife (when ,fe (lookup-foreign-encoding ,fe)))
-            (,s ,str))
+            (,s ,str)
+            (,nt ,null-terminate))
        (if ,ife
-           (sb-ext:string-to-octets ,s :external-format ,ife)
-           (sb-ext:string-to-octets ,s))))
+           (sb-ext:string-to-octets ,s :external-format ,ife :null-terminate ,nt)
+           (sb-ext:string-to-octets ,s :null-terminate ,nt))))
 
 )
 
@@ -117,8 +145,30 @@ encoding.")
             (excl:octets-to-string ,oct :external-format ,ife)
             (excl:octets-to-string ,oct)))))
 
-  #+(or lispworks openmcl)
-  ;; With LW 6.0 and CCL 1.4, writing multibyte character just one octet at a time tests fine
+  #+lispworks
+  ;; With LW 6.0, writing multibyte character just one octet at a time
+  ;; produces expected formatted output, but strings lengths are too
+  ;; long and consists only of octets, not wide characters
+  ;;
+  ;; Below technique of using fli:convert-from-foreign-string works tp
+  ;; correctly create string of wide-characters. However, errors occur
+  ;; during formatted printing of such strings with an error such as
+  ;; "#\U+30D3 is not of type BASE-CHAR"
+  (let ((fe (gensym "FE-"))
+        (ife (gensym "IFE-"))
+        (oct (gensym "OCTETS-")))
+    `(let* ((,fe (or ,encoding *default-foreign-encoding*))
+            (,ife (when ,fe (lookup-foreign-encoding ,fe)))
+            (,oct ,octets))
+       (fli:with-dynamic-foreign-objects
+           ((ptr (:unsigned :byte) :initial-contents (coerce ,oct 'list)))
+         (fli:convert-from-foreign-string ptr
+                                          :length (length ,oct)
+                                          :null-terminated-p nil
+                                          :external-format ,ife))))
+
+  #+(or ccl openmcl)
+  ;; With CCL 1.5, writing multibyte character just one octet at a time tests fine
   (let ((out (gensym "OUT-"))
         (code (gensym "CODE-")))
     `(with-output-to-string (,out)