[cells-cvs] CVS cells-gtk3/gtk-ffi

phildebrandt phildebrandt at common-lisp.net
Mon May 19 10:18:35 UTC 2008


Update of /project/cells/cvsroot/cells-gtk3/gtk-ffi
In directory clnet:/tmp/cvs-serv27464/gtk-ffi

Modified Files:
	gtk-ffi-impl.lisp 
Log Message:
With Ingo's utf-8 patch for clisp and cells-store support


--- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp	2008/04/13 10:59:23	1.1
+++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp	2008/05/19 10:18:35	1.2
@@ -6,6 +6,7 @@
 Currently supported
 
  -- sbcl: utf-8 string handling
+ -- clisp: utf-8 string handling (thanks to Ingo Bormuth)
 
 |#
 
@@ -16,21 +17,24 @@
 ;;; UTF-8 string handling
 ;;;
 
-(defun utf-8-to-lisp (str)
+(defun lisp-to-utf-8 (str)
+  #-(or clisp sbcl) (return-from lisp-to-utf-8 str)
   (when str
-   #+sbcl (let ((s (sb-ext:string-to-octets str :external-format :utf-8)))
-	    (sb-ext:octets-to-string 
-	     (coerce (loop for i from 0 below (length s)
-			for b = (aref s i)
-			collect b
-			if (= b 195) do (incf i 2)) ; ph: gtk gives us 4 bytes per char -- no idea why.  
-		     '(vector (unsigned-byte 8)))
-	     :external-format :utf-8))
-   #-(or sbcl) str))
+    #+clisp (ext:convert-string-to-bytes str charset:utf-8)
+    #+sbcl (sb-ext:string-to-octets str :external-format :utf-8)))
 
-(defun lisp-to-utf-8 (str)
+(defun utf-8-to-lisp (str)
+  #-(or clisp sbcl) (return-from utf-8-to-lisp str)
   (when str
-    #+sbcl (sb-ext:string-to-octets str :external-format :utf-8)
-    #-(or sbcl) str))
+    (let* ((nat (lisp-to-utf-8 str))
+           (oct (coerce (loop for i from 0 below (length nat)
+                           for b = (aref nat i)
+                           collect b
+                           ;; ph: gtk gives us 4 bytes per char ; why ?
+                           if (= b 195) do (incf i 2))
+                        '(vector (unsigned-byte 8)))))
+      #+clisp (ext:convert-string-from-bytes oct charset:utf-8)
+      #+sbcl  (sb-ext:octets-to-string oct :external-format :utf-8))))
+
 
 




More information about the Cells-cvs mailing list