X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fi18n.lisp;h=2de8234f9f659cdef49de31608428368801caca9;hb=9159e69dd3e978531042271bd4e5d0b5695b28bb;hp=1f2bb1ad9a33286fd402304d0a0f8357e7b81458;hpb=a3db800bfa385ae39d729ef0eb8f08a78ceaccdb;p=uffi.git

diff --git a/src/i18n.lisp b/src/i18n.lisp
index 1f2bb1a..2de8234 100644
--- a/src/i18n.lisp
+++ b/src/i18n.lisp
@@ -58,10 +58,8 @@ encoding.")
 (defun lookup-foreign-encoding (normalized)
   (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql)))
 
-(defmacro string-to-octets (str &key (encoding *default-foreign-encoding*))
-  "Converts a Lisp string to a vector of octets."
-  #-(or allegro lispworks openmcl sbcl)
-  (declare (ignore 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))
             #'char-code str)
@@ -69,38 +67,50 @@ encoding.")
   #+allegro
   (let ((fe (gensym "FE-"))
         (ife (gensym "IFE-"))
-        (s (gensym "STR-")))
-    `(let* ((,fe ,encoding)
+        (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)))))
+            (excl:string-to-octets ,s :external-format ,ife :null-terminate ,nt)
+            (excl:string-to-octets ,s :null-terminate ,nt)))))
 
   #+(or lispworks openmcl)
   ;; 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-")))
-    `(let* ((,fe ,encoding)
+        (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))))
 
 )
 
-(defmacro octets-to-string (octets &key (encoding *default-foreign-encoding*))
+(defmacro octets-to-string (octets &key encoding)
   "Converts a vector of octets to a Lisp string."
-  #-(or allegro lispworks openmcl sbcl)
-  (declare (ignore encoding))
+  (declare (ignorable encoding))
   #-(or allegro lispworks openmcl sbcl)
   (let ((out (gensym "OUT-"))
         (code (gensym "CODE-")))
@@ -112,7 +122,7 @@ encoding.")
   (let ((fe (gensym "FE-"))
         (ife (gensym "IFE-"))
         (oct (gensym "OCTETS-")))
-    `(let* ((,fe ,encoding)
+    `(let* ((,fe (or ,encoding *default-foreign-encoding*))
             (,ife (when ,fe (lookup-foreign-encoding ,fe)))
             (,oct ,octets))
        (values
@@ -132,7 +142,7 @@ encoding.")
   (let ((fe (gensym "FE-"))
         (ife (gensym "IFE-"))
         (oct (gensym "OCTETS-")))
-    `(let* ((,fe ,encoding)
+    `(let* ((,fe (or ,encoding *default-foreign-encoding*))
             (,ife (when ,fe (lookup-foreign-encoding ,fe)))
             (,oct ,octets))
        (if ,ife
@@ -141,18 +151,18 @@ encoding.")
 
 )
 
-(defun foreign-encoded-octet-count (str &key (encoding *default-foreign-encoding*))
+(defun foreign-encoded-octet-count (str &key encoding)
   "Returns the octets required to represent the string when passed to a ~
 foreign function."
+  (declare (ignorable encoding))
   ;; AllegroCL 8-bit, CCL, and Lispworks give correct value without converting
   ;; to external-format. AllegroCL 16-bit, SBCL, and CLISP requires conversion
   ;; with external-format
 
   #+(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n))
-  (length (string-to-octets str :encoding encoding))
+  (length (string-to-octets str :encoding
+                            (or encoding *default-foreign-encoding*)))
 
-  #-(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n))
-  (declare (ignore encoding))
   #-(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n))
   (length str)