[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-utilities.lisp

[Peter Denno]

Update of /project/cells-gtk/cvsroot/root/gtk-ffi
In directory common-lisp.net:/tmp/cvs-serv6967/gtk-ffi

Modified Files:
	gtk-utilities.lisp 
Log Message:
Andras's #+allegro patch for tree selection 
Date: Sun Feb 13 18:28:02 2005
Author: pdenno

Index: root/gtk-ffi/gtk-utilities.lisp
diff -u root/gtk-ffi/gtk-utilities.lisp:1.9 root/gtk-ffi/gtk-utilities.lisp:1.10
--- root/gtk-ffi/gtk-utilities.lisp:1.9	Sat Feb 12 16:09:52 2005
+++ root/gtk-ffi/gtk-utilities.lisp	Sun Feb 13 18:28:02 2005
@@ -180,7 +180,7 @@
           (g-value-unset value))))
 
 ;;; todo: The deref-pointer-runtime-typed used by case needs work if
-;;; it is going to be used for lispworks and cmu. 
+;;; it is going to be used for lispworks, cmu and allegro.
 ;;; (needs someone who knows how ffi-to-uffi-type maps types for those lisps.)
 ;;; Even better, eliminate it. It is ill-conceived.
 (defun gtk-tree-model-get-cell (model iter column-no cell-type)
@@ -189,15 +189,19 @@
    column-no = num-columns. (See gtk-tree-store-set-kids)."
   (with-foreign-object (item :pointer-void)
     (gtk-tree-model-get model iter column-no item -1)
-  #-(or lispworks cmu) (cast item (as-gtk-type-name cell-type))
-  #+lispworks 
-  (case cell-type
-    (:string (fli:convert-from-foreign-string (fli:dereference item)))
-    (t (fli:dereference item)))
-  #+cmu
-  (case cell-type
-    (:string (alien:cast (alien:deref item) c-call:c-string))
-    (t (alien:deref item)))))
+ Â #-(or lispworks cmu allegro) (cast item (as-gtk-type-name cell-type))
+Â  Â #+allegro
+Â  Â (case cell-type
+Â  Â  Â (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring)))
+Â  Â  Â (t (cast item (as-gtk-type-name cell-type))))
+   #+lispworks 
+   (case cell-type
+     (:string (fli:convert-from-foreign-string (fli:dereference item)))
+     (t (fli:dereference item)))
+   #+cmu
+   (case cell-type
+     (:string (alien:cast (alien:deref item) c-call:c-string))
+     (t (alien:deref item)))))
 
 (defun parse-cell-attrib (attribs)
   (loop for (attrib val) on attribs by #'cddr collect