New function foreign-encoded-string-octets

[uffi.git] / src / i18n.lisp

diff --git a/src/i18n.lisp b/src/i18n.lisp
index 1d5ec0ab082b6c1490d1b54a5bfcab15a48b3e7b..47a06db565268760cd5e6d3840c4a8683abc4932 100644 (file)
--- 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,23 @@ 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 implementation-foreign-encoding (normalized)
+  (cdr (assoc normalized *foreign-encoding-mapping* :test 'eql)))
+
+(defun foreign-encoded-string-octets (str &optional foreign-encoding)
+  "Returns the octets required to represent the string when passed to a ~
+foreign function."
+  ;; AllegroCL, CCL, and Lispworks give correct value without converting
+  ;; to external-format. CLISP, like SBCL, requires conversion with external-
+  ;; format
+  (length #+(and sbcl sb-unicode)
+          (sb-ext:string-to-octets
+           str
+           :external-format (or foreign-encoding
+                                *default-foreign-encoding*
+                                :utf-8))
+          #-(and sbcl sb-unicode) str))