X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fi18n.lisp;h=a46b5354b01f43c331bb20e54d2c3d7434581363;hb=HEAD;hp=1d6a485145458426532d4d568d079cd9bcf5d5cd;hpb=4b3d6378e1c9ea38fa2eeced4f9f2dfbe41e3a64;p=uffi.git diff --git a/src/i18n.lisp b/src/i18n.lisp index 1d6a485..a46b535 100644 --- a/src/i18n.lisp +++ b/src/i18n.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*- +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -58,8 +58,7 @@ 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." +(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)) @@ -68,35 +67,63 @@ 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))))) - - #+(or lispworks openmcl) + (excl:string-to-octets ,s :external-format ,ife :null-terminate ,nt) + (excl:string-to-octets ,s :null-terminate ,nt))))) + + #+ccl + ;; simply reading each char-code from the LENGTH of string handles + ;; multibyte characters in testing with CCL 1.5 + (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)))) + + #+lispworks ;; 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." (declare (ignorable encoding)) #-(or allegro lispworks openmcl sbcl) @@ -110,7 +137,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 @@ -118,8 +145,30 @@ encoding.") (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 + #+lispworks + ;; With LW 6.0, writing multibyte character just one octet at a time + ;; produces expected formatted output, but strings lengths are too + ;; long and consists only of octets, not wide characters + ;; + ;; Below technique of using fli:convert-from-foreign-string works tp + ;; correctly create string of wide-characters. However, errors occur + ;; during formatted printing of such strings with an error such as + ;; "#\U+30D3 is not of type BASE-CHAR" + (let ((fe (gensym "FE-")) + (ife (gensym "IFE-")) + (oct (gensym "OCTETS-"))) + `(let* ((,fe (or ,encoding *default-foreign-encoding*)) + (,ife (when ,fe (lookup-foreign-encoding ,fe))) + (,oct ,octets)) + (fli:with-dynamic-foreign-objects + ((ptr (:unsigned :byte) :initial-contents (coerce ,oct 'list))) + (fli:convert-from-foreign-string ptr + :length (length ,oct) + :null-terminated-p nil + :external-format ,ife)))) + + #+(or ccl openmcl) + ;; With CCL 1.5, writing multibyte character just one octet at a time tests fine (let ((out (gensym "OUT-")) (code (gensym "CODE-"))) `(with-output-to-string (,out) @@ -130,7 +179,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 @@ -139,7 +188,7 @@ 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)) @@ -148,7 +197,8 @@ foreign function." ;; 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)) (length str)