X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fi18n.lisp;h=1d6a485145458426532d4d568d079cd9bcf5d5cd;hb=4b3d6378e1c9ea38fa2eeced4f9f2dfbe41e3a64;hp=1d5ec0ab082b6c1490d1b54a5bfcab15a48b3e7b;hpb=27073cc090c29aa5dcf9ed9becdf3e73b937b0bb;p=uffi.git

diff --git a/src/i18n.lisp b/src/i18n.lisp
index 1d5ec0a..1d6a485 100644
--- a/src/i18n.lisp
+++ b/src/i18n.lisp
@@ -18,13 +18,13 @@
       (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.")
 
-(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))
@@ -51,9 +51,106 @@ encoding.")
     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.")
 
-(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."
+  (declare (ignorable 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."
+  (declare (ignorable 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."
+  (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))
+
+  #-(or (and allegro ics) (and sbcl sb-unicode) (and clisp i18n))
+  (length str)
+
+)