`(let ((,stored ,obj))
(if (zerop ,stored)
nil
- (values (excl:native-to-string ,stored)))))
+ (values
+ (excl:native-to-string
+ ,stored
+ :external-format
+ (if *default-external-format*
+ (map-normalized-external-format
+ *default-external-format*)
+ :default))))))
#+(or openmcl digitool)
(let ((stored (gensym)))
`(let ((,stored ,obj))
`(let ((,stored ,obj))
(if (null ,stored)
0
- (values (excl:string-to-native ,stored)))))
+ (values (excl:string-to-native
+ ,stored
+ :external-format
+ (if *default-external-format*
+ (map-normalized-external-format
+ *default-external-format*)
+ :default))))))
#+(or openmcl digitool)
(let ((stored (gensym)))
`(let ((,stored ,obj))
(let ((acl-native (gensym))
(stored-lisp-string (gensym)))
`(let ((,stored-lisp-string ,lisp-string))
- (excl:with-native-string (,acl-native ,stored-lisp-string)
+ (excl:with-native-string (,acl-native ,stored-lisp-string
+ :external-format
+ (if *default-external-format*
+ (map-normalized-external-format
+ *default-external-format*)
+ :default))
(let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
,@body))))
#+(or openmcl digitool)
(let ((stored-lisp-string (gensym)))
`(let ((,stored-lisp-string ,lisp-string))
(if (stringp ,stored-lisp-string)
- (ccl:with-cstrs ((,cstring ,stored-lisp-string))
+ (ccl:with-encoded-cstrs
+ (or *default-external-format* :iso-8859-1)
+ ((,cstring ,stored-lisp-string))
,@body)
(let ((,cstring +null-cstring-pointer+))
,@body))))
;;; Foreign string functions
-(defmacro convert-to-foreign-string (obj)
+(defmacro convert-to-foreign-string (obj &optional external-format)
#+lispworks
- (let ((stored (gensym)))
- `(let ((,stored ,obj))
+ (let ((stored (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored ,obj)
+ (,ef (map-normalized-external-format
+ (or external-format *default-external-format*))))
(if (null ,stored)
+null-cstring-pointer+
(fli:convert-to-foreign-string
,stored
- :external-format '(:latin-1 :eol-style :lf)))))
+ :external-format ,ef))))
#+allegro
- (let ((stored (gensym)))
- `(let ((,stored ,obj))
+ (let ((stored (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored ,obj)
+ (,ef (map-normalized-external-format
+ (or external-format *default-external-format*))))
(if (null ,stored)
0
- (values (excl:string-to-native ,stored)))))
+ (values (excl:string-to-native ,stored :external-format
+ (or ,ef :default))))))
#+(or cmu scl)
(let ((size (gensym))
(storage (gensym))
;; Either length or null-terminated-p must be non-nil
(defmacro convert-from-foreign-string (obj &key
- length
- (locale :default)
- (null-terminated-p t))
+ length
+ external-format
+ (null-terminated-p t))
#+allegro
- (let ((stored-obj (gensym)))
- `(let ((,stored-obj ,obj))
+ (let ((stored-obj (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored-obj ,obj)
+ (,ef (map-normalized-external-format
+ (or ,external-format *default-external-format*))))
(if (zerop ,stored-obj)
nil
- (if (eq ,locale :none)
- (fast-native-to-string ,stored-obj ,length)
+ (if ,ef
(values
(excl:native-to-string
,stored-obj
,@(when length (list :length length))
- :truncate (not ,null-terminated-p)))))))
+ :truncate (not ,null-terminated-p)
+ :external-format ,ef))
+ (fast-native-to-string ,stored-obj ,length)))))
#+lispworks
- (let ((stored-obj (gensym)))
- `(let ((,stored-obj ,obj))
+ (let ((stored-obj (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored-obj ,obj)
+ (,ef (map-normalized-external-format
+ (or ,external-format *default-external-format*))))
(if (fli:null-pointer-p ,stored-obj)
nil
- (if (eq ,locale :none)
- (fast-native-to-string ,stored-obj ,length)
+ (if ,ef
(fli:convert-from-foreign-string
,stored-obj
,@(when length (list :length length))
:null-terminated-p ,null-terminated-p
- :external-format '(:latin-1 :eol-style :lf))))))
+ :external-format (list ,ef))
+ (fast-native-to-string ,stored-obj ,length)))))
#+(or cmu scl)
(let ((stored-obj (gensym)))
`(let ((,stored-obj ,obj))
:null-terminated-p ,null-terminated-p))))
#+sbcl
- (let ((stored-obj (gensym)))
- `(let ((,stored-obj ,obj))
+ (let ((stored-obj (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored-obj ,obj)
+ (,ef (map-normalized-external-format
+ (or ,external-format *default-external-format*))))
(if (null-pointer-p ,stored-obj)
nil
- (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
- :length ,length
- :null-terminated-p ,null-terminated-p))))
+ (if ,ef
+ (sb-alien::c-string-to-string (sb-alien:alien-sap ,stored-obj)
+ ,ef 'character)
+ (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p)))))
#+(or openmcl digitool)
(declare (ignore null-terminated-p))
#+(or openmcl digitool)
- (let ((stored-obj (gensym)))
- `(let ((,stored-obj ,obj))
+ (let ((stored-obj (gensym "STR-"))
+ (ef (gensym "EF-")))
+ `(let ((,stored-obj ,obj)
+ (,ef (map-normalized-external-format
+ (or ,external-format *default-external-format*))))
(if (ccl:%null-ptr-p ,stored-obj)
nil
#+digitool (ccl:%get-cstring
,stored-obj 0
,@(if length (list length) nil))
- #+openmcl ,@(if length
- `((ccl:%str-from-ptr ,stored-obj ,length))
- `((ccl:%get-cstring ,stored-obj))))))
+ #+openmcl (case ,ef
+ (:utf-8
+ (ccl::%get-utf-8-cstring ,stored-obj))
+ (:ucs-2
+ (ccl::%get-native-utf-16-cstring ,stored-obj))
+ (t
+ ,@(if length
+ `((ccl:%str-from-ptr ,stored-obj ,length))
+ `((ccl:%get-cstring ,stored-obj))))))))
)