Version 1.8.2: Test suite and more functions for foreign string encoding

[uffi.git] / src / i18n.lisp

diff --git a/src/i18n.lisp b/src/i18n.lisp
index 1d5ec0ab082b6c1490d1b54a5bfcab15a48b3e7b..1f2bb1ad9a33286fd402304d0a0f8357e7b81458 100644 (file)
--- a/src/i18n.lisp
+++ b/src/i18n.lisp
@@ -18,13 +18,13 @@
       (and openmcl openmcl-unicode-strings))
 (pushnew 'no-i18n cl:*features*)
 
       (and openmcl openmcl-unicode-strings))
 (pushnew 'no-i18n cl:*features*)
 

-(defvar *default-external-format*
+(defvar *default-foreign-encoding*

   nil
   "Normalized name of default external character format to use
 for foreign string conversions. nil means use implementation default
 encoding.")
 
   nil
   "Normalized name of default external character format to use
 for foreign string conversions. nil means use implementation default
 encoding.")
 

-(defvar *external-format-mapping*
+(defvar *foreign-encoding-mapping*

     #+(and lispworks unicode)
     '((:ascii . :ascii) (:latin-1 . :latin-1) (:ucs-2 . :unicode)
       (:utf-8 . :utf-8) (:jis . :jis) (:sjis . :sjis) (:gbk . :gbk))
     #+(and lispworks unicode)
     '((:ascii . :ascii) (:latin-1 . :latin-1) (:ucs-2 . :unicode)
       (:utf-8 . :utf-8) (:jis . :jis) (:sjis . :sjis) (:gbk . :gbk))


@@ -51,9 +51,109 @@ encoding.")
     nil
   "Mapping between normalized external format name and implementation name.")
 
     nil
   "Mapping between normalized external format name and implementation name.")
 

-(defvar *external-formats*
-  (mapcar 'car *external-format-mapping*)
+(defvar *foreign-encodings*
+  (mapcar 'car *foreign-encoding-mapping*)

   "List of normalized names of external formats support by underlying implementation.")
 
   "List of normalized names of external formats support by underlying implementation.")
 

-(defun map-normalized-external-format (normalized)
-  (cdr (assoc normalized *external-format-mapping* :test 'eql)))
+(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))
+  #-(or allegro lispworks openmcl sbcl)
+  (map-into (make-array (length str) :element-type '(unsigned-byte 8))
+            #'char-code str)
+
+  #+allegro
+  (let ((fe (gensym "FE-"))
+        (ife (gensym "IFE-"))
+        (s (gensym "STR-")))
+    `(let* ((,fe ,encoding)
+            (,ife (when ,fe (lookup-foreign-encoding ,fe)))
+            (,s ,str))
+       (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)
+  ;; 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)
+
+  #+sbcl
+  (let ((fe (gensym "FE-"))
+        (ife (gensym "IFE-"))
+        (s (gensym "STR-")))
+    `(let* ((,fe ,encoding)
+            (,ife (when ,fe (lookup-foreign-encoding ,fe)))
+            (,s ,str))
+       (if ,ife
+           (sb-ext:string-to-octets ,s :external-format ,ife)
+           (sb-ext:string-to-octets ,s))))
+
+)
+
+(defmacro octets-to-string (octets &key (encoding *default-foreign-encoding*))
+  "Converts a vector of octets to a Lisp string."
+  #-(or allegro lispworks openmcl sbcl)
+  (declare (ignore encoding))
+  #-(or allegro lispworks openmcl sbcl)
+  (let ((out (gensym "OUT-"))
+        (code (gensym "CODE-")))
+    `(with-output-to-string (,out)
+       (loop for ,code across ,octets
+          do (write-char (code-char ,code) ,out))))
+
+  #+allegro
+  (let ((fe (gensym "FE-"))
+        (ife (gensym "IFE-"))
+        (oct (gensym "OCTETS-")))
+    `(let* ((,fe ,encoding)
+            (,ife (when ,fe (lookup-foreign-encoding ,fe)))
+            (,oct ,octets))
+       (values
+        (if ,ife
+            (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
+  (let ((out (gensym "OUT-"))
+        (code (gensym "CODE-")))
+    `(with-output-to-string (,out)
+       (loop for ,code across ,octets
+          do (write-char (code-char ,code) ,out))))
+
+  #+sbcl
+  (let ((fe (gensym "FE-"))
+        (ife (gensym "IFE-"))
+        (oct (gensym "OCTETS-")))
+    `(let* ((,fe ,encoding)
+            (,ife (when ,fe (lookup-foreign-encoding ,fe)))
+            (,oct ,octets))
+       (if ,ife
+           (sb-ext:octets-to-string ,oct :external-format ,ife)
+           (sb-ext:octets-to-string ,oct))))
+
+)
+
+(defun foreign-encoded-octet-count (str &key (encoding *default-foreign-encoding*))
+  "Returns the octets required to represent the string when passed to a ~
+foreign function."
+  ;; 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))
+
+  #-(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)
+
+)