From pdenno at common-lisp.net  Sat Feb 11 03:34:09 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:34:09 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060211033409.AFB875A013@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv30914/root/cells-gtk

Modified Files:
	drawing.lisp 
Log Message:
Replaced hello-c stuff with cffi stuff

--- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/01/03 19:03:33	1.3
+++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/02/11 03:34:09	1.4
@@ -17,57 +17,58 @@
 
 (in-package :gtk-ffi)
 
-(ffx:ff-defun-callable :cdecl :int drawing-expose-event-handler
-  ((drawing-area :pointer-void) (signal (* gdk-event-expose)) (data :pointer-void))
+(cffi:defcallback drawing-expose-event-handler :int
+  ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data signal gkd-event-expose widget))
-  (bwhen (self (cgtk::gtk-object-find drawing-area))
-    (cgtk::init-graphics-context drawing-area)
-    ;; POD This should draw the entire backing-pixmap
-    (gdk-draw-drawable 
-     cgtk::*window* cgtk::*gcontext* 
-     (funcall (funcall (intern "DRAW-FN" :cells-gtk)  self) self)
+  (bwhen (self (gtk-object-find drawing-area))
+    (init-graphics-context drawing-area)
+    (gdk-draw-drawable
+     *window*
+     *gcontext*
+     (funcall (funcall (intern "draw-fn" :cells-gtk) self) self)
      0 0 0 0 -1 -1)
-  0))
+    0))
 
-
-(ffx:ff-defun-callable :cdecl :int drawing-button-events-handler
-  ((drawing-area :pointer-void) (signal (* gdk-event-button)) (data :pointer-void))
+(cffi:defcallback drawing-button-events-handler :int
+  ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data))
-  (bwhen (self (cgtk::gtk-object-find drawing-area))
+  (bwhen (self (gtk-object-find drawing-area))
     (let ((event (gdk-event-button-type signal)))
-      (when (and (eql (event-type event) :button_press) 
-		 (= (gdk-event-button-button signal) 1))
-	(setf (cgtk::button1-down self) (cons (truncate (gdk-event-button-x signal))
-					(truncate (gdk-event-button-y signal)))))
-      (when (and (eql (event-type event) :button_release) 
-		 (= (gdk-event-button-button signal) 1))
-	(setf (cgtk::button1-down self) nil))))
+      (when (and (eql (event-type event) :button_press)
+                 (= (gdk-event-button-button signal) 1))
+        (setf (button1-down self)
+              (cons (truncate (gdk-event-button-x signal))
+                    (truncate (gdk-event-button-y signal)))))
+      (when (and (eql (event-type event) :button_release)
+                 (= (gdk-event-button-button signal) 1))
+        (setf (button1-down self) nil))))
   0)
 
-(ffx:ff-defun-callable :cdecl :int drawing-pointer-motion-handler
-  ((drawing-area :pointer-void) (signal (* gdk-event-motion)) (data :pointer-void))
+
+(cffi:defcallback drawing-pointer-motion-handler :int
+  ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data signal widget))
-  (bwhen (self (cgtk::gtk-object-find drawing-area))
-    (bwhen (button1 (cgtk::button1-down self))
-       (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1)))
-	     (dy (- (truncate (gdk-event-motion-y signal)) (cdr button1))))
-	;; POD NYI this should drag the thing closest to pointer, and redraw around it.
-	 (loop for drawable being the hash-value of (cgtk::gobjects self) do
-	       (gdk-draw-drawable cgtk::*window* cgtk::*gcontext* drawable 0 0 dx dy -1 -1)))))
+  (bwhen (self (gtk-object-find drawing-area))
+    (bwhen (button1 (button1-down self))
+      (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1)))
+            (dy(- (truncate (gdk-event-motion-y signal)) (cdr button1))))
+        (loop for drawable being the hash-value of (gobjects self) do
+             (gdk-draw-drawable *window* *gcontext* drawable 0 0 dx dy -1 -1)))))
   0)
 
+
 (defun gtk-drawing-set-handlers (widget data)
   (gtk-signal-connect-swap widget "button-press-event"
-			   (ffx:ff-register-callable 'drawing-button-events-handler)
+			   (cffi:get-callback 'drawing-button-events-handler)
 			   :data data)
   (gtk-signal-connect-swap widget "button-release-event"
-			   (ffx:ff-register-callable 'drawing-button-events-handler)
+			   (cffi:get-callback 'drawing-button-events-handler)
 			   :data data)
   (gtk-signal-connect-swap widget "motion-notify-event"
-			   (ffx:ff-register-callable 'drawing-pointer-motion-handler)
+			   (cffi:get-callback 'drawing-pointer-motion-handler)
 			   :data data)
   (gtk-signal-connect-swap widget "expose-event"
-			   (ffx:ff-register-callable 'drawing-expose-event-handler)
+			   (cffi:get-callback 'drawing-expose-event-handler)
 			   :data data))
 (export '(gtk-drawing-set-handlers))
 



From pdenno at common-lisp.net  Sat Feb 11 03:35:13 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:35:13 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060211033513.A94E05B016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv31015/root/cells-gtk

Modified Files:
	packages.lisp 
Log Message:
Removed reference to package ffx

--- /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/01/03 18:59:58	1.2
+++ /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/02/11 03:35:13	1.3
@@ -18,8 +18,7 @@
 
 (defpackage :cells-gtk
   (:nicknames :cgtk)
-  (:use :common-lisp :utils-kt :cells :gtk-ffi
-    :uffi #:ffx))
+  (:use :common-lisp :utils-kt :cells :gtk-ffi :uffi ))
 
 
 



From pdenno at common-lisp.net  Sat Feb 11 03:37:13 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:37:13 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060211033713.721DF5B016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv31035/root/cells-gtk

Modified Files:
	textview.lisp 
Log Message:
Replaced hello-c:ff-defun-callable with cffi:defcallback

--- /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/01/03 19:01:20	1.6
+++ /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/02/11 03:37:13	1.7
@@ -69,8 +69,8 @@
            when (eql type :menu-item)
            collect `(funcall #'make-instance 'populate-adds , at args))))
 
-(ff-defun-callable :cdecl :void text-view-populate-popup-handler
-  ((widget :pointer-void) (signal :pointer-void) (data :pointer-void))
+(cffi:defcallback text-view-populate-popup-handler :void
+                  ((widget :pointer) (signal :pointer) (data :pointer))
   (let ((popup-menu (gtk-adds-text-view-popup-menu widget)))
     (bwhen (text-view (gtk-object-find widget))
       (bwhen (cb (callback-recover text-view :populate-popup))
@@ -81,7 +81,7 @@
   (when new-value
       (callback-register self :populate-popup (populate-popup-closure (reverse new-value) self))
       (gtk-signal-connect (id self) "populate-popup"
-                          (ffx:ff-register-callable 'text-view-populate-popup-handler))))
+                          (cffi:get-callback 'text-view-populate-popup-handler))))
 
 (defun populate-popup-closure (p-adds text-view)
   (let (accum)



From pdenno at common-lisp.net  Sat Feb 11 03:38:02 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:38:02 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060211033802.20BD55B016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv31057/root/cells-gtk

Modified Files:
	tree-view.lisp 
Log Message:
Replaced hello-c:ff-defun-callable with cffi:defcallback

--- /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/01/03 19:01:59	1.12
+++ /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/02/11 03:38:02	1.13
@@ -82,20 +82,19 @@
         finally (return node)))
 
 ;;; Used by combo-box also, when it is using a tree model. 
-(ff-defun-callable :cdecl :void tree-view-items-selector
-  ((model :pointer-void) (path :pointer-void) (iter :pointer-void) (data :pointer-void))
+(cffi:defcallback tree-view-items-selector :void
+  ((model :pointer) (path :pointer) (iter :pointer) (data :pointer))
   (let ((tree (of-tree (gtk-object-find model))))
-    (push (item-from-path 
-           (children-fn tree)
-           (roots tree)
-           (read-from-string 
-            (gtk-tree-model-get-cell model iter (length (column-types tree)) :string)))
+    (push (item-from-path (children-fn tree)
+            (roots tree)
+	    (read-from-string 
+	     (gtk-tree-model-get-cell model iter (length (column-types tree)) :string)))
           (selected-items-cache tree)))
   0)
 
 (defmethod get-selection ((self tree-view))
   (let ((selection (gtk-tree-view-get-selection (id self)))
-        (cb (ff-register-callable 'tree-view-items-selector)))
+        (cb (cffi:get-callback 'tree-view-items-selector)))
     (setf (selected-items-cache self) nil)
     (gtk-tree-selection-selected-foreach selection cb c-null)
     (if (equal (gtk-tree-selection-get-mode selection) 3) ;;multiple
@@ -112,12 +111,12 @@
 	   (:browse 2)
 	   (:multiple 3))))))
 
-(ff-defun-callable :cdecl :void tree-view-select-handler
-  ((column-widget :pointer-void) (event :pointer-void) (data :pointer-void))
+(cffi:defcallback tree-view-select-handler :void
+ ((column-widget :pointer) (event :pointer) (data :pointer))
   (bif (tree-view (gtk-object-find column-widget))
-    (let ((cb (callback-recover tree-view :on-select)))
-      (funcall cb tree-view column-widget event data))
-    (trc "dude, clean up old widgets after runs" column-widget))
+       (let ((cb (callback-recover tree-view :on-select)))
+         (funcall cb tree-view column-widget event data))
+       (trc "Clean up old widgets after runs" column-widget))
   0)
 
 ;;; The check that previously was performed here (for a clos object) caused the handler
@@ -127,7 +126,7 @@
     (let ((selected-widget (gtk-tree-view-get-selection (id self))))
       (gtk-object-store selected-widget self) ;; tie column widget to clos tree-view
       (callback-register self :on-select new-value)
-      (let ((cb (ff-register-callable 'tree-view-select-handler)))
+      (let ((cb (cffi:get-callback 'tree-view-select-handler)))
         ;(trc nil "tree-view on-select pcb:" cb selected-widget "changed")
         (gtk-signal-connect selected-widget "changed" cb)))))
 
@@ -209,14 +208,14 @@
            (gtk-tree-store-set-kids model sub-tree iter
             pos column-types print-fn children-fn (cons index path)))))
 
-(ff-defun-callable :cdecl :int tree-view-render-cell-callback
-    ((tree-column :pointer-void) (cell-renderer :pointer-void)
-     (tree-model :pointer-void) (iter :pointer-void) (data :pointer-void))
+(cffi:defcallback tree-view-render-cell-callback :int
+  ((tree-column :pointer) (cell-renderer :pointer) (tree-model :pointer) 
+   (iter :pointer) (data :pointer))
   (bif (self (gtk-object-find tree-column))
-    (let ((cb (callback-recover self :render-cell)))
-      (assert cb () "No :render-cell callback for ~a" self)
-      (funcall cb tree-column cell-renderer tree-model iter data))
-    (trc nil "dude, clean up old widgets from prior runs" tree-column))
+       (let ((cb (callback-recover self :render-cell)))
+         (assert cb nil "no :render-cell callback for ~a" self)
+         (funcall cb tree-column cell-renderer tree-model iter data))
+       (trc nil "Clean up old widgets from prior runs." tree-column))
   1)
 
 (def-c-output columns ((self tree-view))
@@ -229,7 +228,7 @@
                          (t (gtk-cell-renderer-text-new))) do
           (gtk-tree-view-column-pack-start (id col) renderer t)
           (gtk-tree-view-column-set-cell-data-func (id col) renderer
-            (let ((cb (ff-register-callable 'tree-view-render-cell-callback)))
+            (let ((cb (cffi:get-callback 'tree-view-render-cell-callback)))
               ;(trc nil "tree-view columns pcb:" cb (id col) :render-cell)
               (callback-register col :render-cell
                 (gtk-tree-view-render-cell pos 



From pdenno at common-lisp.net  Sat Feb 11 03:39:10 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:39:10 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060211033910.2F0355B016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv31088/root/cells-gtk

Modified Files:
	widgets.lisp 
Log Message:
Replaced hello-c:ff-defun-callable with cffi:defcallback.
Replaced some fgn-alloc fgn-free stuff with equivalent cffi.

--- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/01/03 19:03:02	1.15
+++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/02/11 03:39:10	1.16
@@ -110,15 +110,15 @@
       (intern (format nil "GTK-~a~{-~a~}" class slot-access) :gtk-ffi))))
 
 ;;; --- widget --------------------
-;;; Define handlers that recover the the callback defined on the widget
+;;; Define handlers that recover the callback defined on the widget
+
 (defmacro def-gtk-event-handler (event)
-  `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event)))
-     ((widget :pointer-void) (event :pointer-void) (data :pointer-void))
-     ;(print (list :entered-gtk-event-handler-cb ,(symbol-name event) widget))
+  `(cffi:defcallback ,(intern (format nil "~a-HANDLER" event)) :int
+     ((widget :pointer) (event :pointer) (data :pointer))
      (bif (self (gtk-object-find widget))
-       (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword))))
-         (funcall cb self widget event data))
-       (trc nil "unknown widget. from prior run. clean up on errors" widget))))
+	  (let ((cb (callback-recover self ,(intern (string event) :keyword))))
+	    (funcall cb self widget event data))
+	  (trc nil "Unknown widget from prior run. Clean up on errors" widget))))
 
 (def-gtk-event-handler clicked)
 (def-gtk-event-handler changed)
@@ -131,15 +131,15 @@
 (def-gtk-event-handler modified-changed)
 
 (defparameter *widget-callbacks*
-  (list (cons 'clicked (ff-register-callable 'clicked-handler))
-    (cons 'changed (ff-register-callable 'changed-handler))
-    (cons 'activate (ff-register-callable 'activate-handler))
-    (cons 'value-changed (ff-register-callable 'value-changed-handler))
-    (cons 'day-selected (ff-register-callable 'day-selected-handler))
-    (cons 'selection-changed (ff-register-callable 'selection-changed-handler))
-    (cons 'toggled (ff-register-callable 'toggled-handler))
-    (cons 'delete-event (ff-register-callable 'delete-event-handler))
-    (cons 'modified-changed (ff-register-callable 'modified-changed-handler))))
+  (list (cons 'clicked (cffi:get-callback 'clicked-handler))
+    (cons 'changed (cffi:get-callback 'changed-handler))
+    (cons 'activate (cffi:get-callback 'activate-handler))
+    (cons 'value-changed (cffi:get-callback 'value-changed-handler))
+    (cons 'day-selected (cffi:get-callback 'day-selected-handler))
+    (cons 'selection-changed (cffi:get-callback 'selection-changed-handler))
+    (cons 'toggled (cffi:get-callback 'toggled-handler))
+    (cons 'delete-event (cffi:get-callback 'delete-event-handler))
+    (cons 'modified-changed (cffi:get-callback 'modified-changed-handler))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   
@@ -226,14 +226,11 @@
                    , at body
                    1))))
 
-(ff-defun-callable :cdecl :int timeout-handler-callback
-     ((data (* :int)))
-   ;;(print (list :timeout-handler-callback data))
-   (let* ((id (elti data 0))
-          (r2 (gtk-global-callback-funcall id)))
-     (trc nil "timeout func really returning" r2)
-     (if r2 1 0)))
-
+(cffi:defcallback timeout-handler-callback :int ((data :pointer))
+  (let* ((id (cffi:mem-aref data :int 0))
+	 (r2 (gtk-global-callback-funcall id)))
+    (trc nil "timeout func really returning" r2)
+    (if r2 1 0)))
 
 (defun timeout-add (milliseconds function)
   (let ((id (gtk-global-callback-register
@@ -244,9 +241,9 @@
                   (trc nil "timeout func returning" r)
                   r))))
         (c-id (fgn-alloc :int 1)))
-    (setf (elti c-id 0) id)
-    (trc nil "timeout-add > passing cb data, *data" c-id (elti c-id 0))
-    (g-timeout-add milliseconds (ff-register-callable 'timeout-handler-callback) c-id)))
+    (setf (cffi:mem-aref c-id :int 0) (coerce id 'integer))
+    (trc nil "timeout-add > passing cb data, *data" c-id (cffi:mem-aref c-id :int 0))
+    (g-timeout-add milliseconds (cffi:get-callback 'timeout-handler-callback) c-id)))
 
 (def-object widget ()
   ((tooltip :accessor tooltip :initarg :tooltip :initform (c-in nil))



From pdenno at common-lisp.net  Sat Feb 11 03:40:26 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:40:26 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034026.9793E5C011@common-lisp.net>

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

Modified Files:
	gtk-core.lisp 
Log Message:
Replaced some fgn-alloc fgn-free stuff with equivalent cffi.

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/01/03 19:05:17	1.5
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/02/11 03:40:26	1.6
@@ -49,7 +49,7 @@
   (gdk-flush ()))
 
 (def-union g-value-data
-    (v-int :int)
+  (v-int :int)
   (v-uint :unsigned-int)
   (v-long :long)
   (v-ulong :unsigned-long)
@@ -69,14 +69,14 @@
 
 (defun call-with-g-value (fn)
   (declare (optimize (speed 3) (safety 0) (space 0)))
-  (let ((gva (ffx:fgn-alloc 'g-value 1 :with-g-value)))
+  (let ((gva (cffi:foreign-alloc 'g-value)))
     (unwind-protect
         (dotimes (n 16)
-            (let ((gv (ffx:ff-elt gva 'g-value 0)))
-              (let ((ns (get-slot-pointer gv 'g-value 'g-type)))
-		(setf (deref-array ns '(:array :int) n) 0))))
+            (let* ((gv (cffi:mem-aref gva 'g-value 0))
+		   (ns (get-slot-pointer gv 'g-value 'g-type)))
+		(setf (cffi:mem-aref ns ':int n) 0))))
           (funcall fn gva)
-      (ffx:fgn-free gva))))
+      (cffi:foreign-free gva)))
 
 (eval-when (compile load eval) (export 'with-g-value))
 



From pdenno at common-lisp.net  Sat Feb 11 03:41:05 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:41:05 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034105.208F65C011@common-lisp.net>

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

Modified Files:
	gtk-definitions.lisp 
Log Message:
Replaced some fgn-alloc fgn-free stuff with equivalent cffi.

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-definitions.lisp	2004/12/05 06:31:14	1.2
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-definitions.lisp	2006/02/11 03:41:05	1.3
@@ -64,14 +64,15 @@
 (def-struct g-value
     (g-type (:array :int 16)))
 
+;;; POD variable capture!
 (defmacro with-g-value ((var) &body body)
-  `(let ((,var (ffx:fgn-alloc 'g-value 1 :with-g-value ',var)))
+  `(let ((,var (cffi:foreign-alloc 'g-value)))
      (unwind-protect
          (progn 
            (dotimes (n 16)
              (setf (int-slot-indexed ,var 'g-value 'g-type n) 0))
            , at body)
-       (ffx:fgn-free ,var))))
+       (cffi:foreign-free ,var))))
 
 (eval-when (compile load eval) (export 'with-g-value))
 



From pdenno at common-lisp.net  Sat Feb 11 03:43:48 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:43:48 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034348.252AA5C011@common-lisp.net>

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

Removed Files:
	ffx.lisp 
Log Message:
No longer used.




From pdenno at common-lisp.net  Sat Feb 11 03:44:32 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:44:32 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034432.1C9CF5C011@common-lisp.net>

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

Modified Files:
	gtk-ffi.asd 
Log Message:
removed reference to ffx.lisp

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/01/03 19:06:22	1.10
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/02/11 03:44:32	1.11
@@ -12,8 +12,8 @@
 ;;; Specify for Lispworks (definitely), other maybe.
 #+macosx(setf *gtk-lib-path* "/sw/lib/")
 #+(or win32 mswindows)(setf *gtk-lib-path* "E:/GTK/bin/")
-;#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/usr/lib/") 
-#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/opt/gnome/lib/")  ; For my SuSE machine
+#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/usr/lib/") 
+;#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/opt/gnome/lib/")  ; For my SuSE machine
 
 ;;; Step 2 -- If you built or downloaded the libcellsgtk library, uncomment the next line.
 (pushnew :libcellsgtk *features*)
@@ -22,8 +22,7 @@
   :name "gtk-ffi"
   :depends-on (:cells :cffi :cffi-uffi-compat)
   :components
-  ((:file "ffx") ; Novikov Leonid's compatibility stuff from hello-c
-   (:file "gtk-ffi" :depends-on ("ffx"))
+  ((:file "gtk-ffi")
    (:file "gtk-core" :depends-on ("gtk-ffi"))
    (:file "gtk-other" :depends-on ("gtk-ffi"))
    (:file "gtk-button" :depends-on ("gtk-ffi"))



From pdenno at common-lisp.net  Sat Feb 11 03:45:55 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:45:55 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034555.029A35D013@common-lisp.net>

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

Modified Files:
	gtk-ffi.lisp 
Log Message:
muffle-warning on style-warning, cffi stuff

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/01/04 16:32:44	1.15
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/11 03:45:55	1.16
@@ -17,7 +17,7 @@
 |#
 
 
-(defpackage :gtk-ffi (:use :common-lisp :ffx :uffi))
+(defpackage :gtk-ffi (:use :common-lisp :uffi))
 
 (in-package :gtk-ffi)
 
@@ -56,10 +56,11 @@
       #+libcellsgtk (:cgtk  "libcellsgtk.dll")))
   (defun load-gtk-libs ()
     (macrolet ((loadit (libname module) 
-		       `(uffi:load-foreign-library 		 
-			 (concatenate 'string cl-user::*gtk-lib-path* ,libname)
-                         :force-load #+lispworks t #-lispworks nil
-			 :module ,(string module))))
+		       `(handler-bind ((style-warning #'muffle-warning))
+			  (uffi:load-foreign-library 		 
+			   (concatenate 'string cl-user::*gtk-lib-path* ,libname)
+			   :force-load #+lispworks t #-lispworks nil
+			   :module ,(string module)))))
       #+(or win32 mswindows)
       (progn 
 	(loadit "libgobject-2.0-0.dll" :gobject)
@@ -136,13 +137,13 @@
                finally (return (list (mapcar 'list gsyms arg$s)
                                  pass-args)))))
       `(progn
-         (uffi:def-function (,gtk-name$ ,gtk-name)
-             ,(mapcar (lambda (name-type)
-                        (destructuring-bind (name type) name-type
-                          (list name (ffi-to-uffi-type type))))
-                arguments)
-           :module ,(string library)
-           :returning ,(ffi-to-uffi-type return-type))
+	  (uffi:def-function (,gtk-name$ ,gtk-name)
+	     ,(mapcar (lambda (name-type)
+			(destructuring-bind (name type) name-type
+			  (list name (ffi-to-uffi-type type))))
+		      arguments)
+	     :module ,(string library)
+	     :returning ,(ffi-to-uffi-type return-type))
          (defun ,name ,(mapcar 'car arguments)
            (when *gtk-debug*
              ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")



From pdenno at common-lisp.net  Sat Feb 11 03:46:42 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:46:42 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034642.3603D5D013@common-lisp.net>

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

Modified Files:
	gtk-other.lisp 
Log Message:
Removed duplicate gtk-text-buffer-get-char-count

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-other.lisp	2006/01/03 19:09:41	1.11
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-other.lisp	2006/02/11 03:46:42	1.12
@@ -18,7 +18,6 @@
 
 (in-package :gtk-ffi)
 
-
 (def-gtk-lib-functions :gtk
   ;; main-loop
   (gtk-init ((argc (c-ptr-null int))
@@ -636,8 +635,6 @@
                               (tag c-pointer)
                               (start c-pointer)
                               (end c-pointer)))
-  (gtk-text-buffer-get-char-count ((buffer c-pointer))
-     int)
   (gtk-text-buffer-create-mark ((buffer c-pointer)
                                 (mark-name c-string)
                                 (where c-pointer)



From pdenno at common-lisp.net  Sat Feb 11 03:48:09 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:48:09 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060211034809.E5C295D013@common-lisp.net>

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

Modified Files:
	gtk-utilities.lisp 
Log Message:
Replaced hello-c:ff-defun-callable with cffi:defcallback.
Replaced some fgn-alloc fgn-free stuff with equivalent cffi.

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/01/03 19:10:45	1.16
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/11 03:48:09	1.17
@@ -82,46 +82,36 @@
 	  , at body)
      (gdk-threads-leave)))
 
-(ffx:ff-defun-callable :cdecl :int button-press-event-handler
-  ((widget :pointer-void) (signal (* gdk-event-button)) (data :pointer-void))
+(cffi:defcallback button-press-event-handler :int
+                  ((widget :pointer) (signal :pointer) (data :pointer))
   (let ((event (gdk-event-button-type signal)))
-    (when (or (eql (event-type event) :button_press) 
+    (when (or (eql (event-type event) :button_press)
               (eql (event-type event) :button_release))
       (when (= (gdk-event-button-button signal) 3)
-        (gtk-menu-popup widget nil nil nil nil 3 
-          (gdk-event-button-time signal)))))
+        (gtk-menu-popup widget nil nil nil nil 3
+			(gdk-event-button-time signal)))))
   0)
 
 (defun gtk-widget-set-popup (widget menu)
   (gtk-signal-connect-swap widget "button-press-event"
-                           (ffx:ff-register-callable 'button-press-event-handler)
+                           (cffi:get-callback 'button-press-event-handler)
                            :data menu)
   (gtk-signal-connect-swap widget "button-release-event"
-                           (ffx:ff-register-callable 'button-press-event-handler)
+                           (cffi:get-callback 'button-press-event-handler)
                            :data menu))
 
 (defun gtk-list-store-new (col-types)
-  (let ((c-types (ffx:fgn-alloc :int (length col-types))))
+  (let ((c-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))))
     (loop for type in col-types
           for n upfrom 0
-          do (setf (ffx:elti c-types n) (as-gtk-type type)))
+          do (setf (cffi:mem-aref c-types :int n) (coerce (as-gtk-type type) 'integer)))
     (prog1
         (gtk-list-store-newv (length col-types) c-types)
-      (ffx:fgn-free c-types))))
+      (cffi:foreign-free c-types))))
 
 
 (defun gvi (&optional (key :anon))
-  key
-;;;  (ukt:trc nil "gvi> " keY)
-;;;  (let ((tv (ffx:fgn-alloc :int 32)))
-;;;    (dotimes (n 32) (setf (ffx:elti tv n) 0))
-;;;    (loop for type in '(:string :icon :int :string)
-;;;        do (print (list tv type (as-gtk-type type)
-;;;                    (g_value_init tv (as-gtk-type type))))
-;;;          (g_value_unset tv))
-;;;    (ffx:fgn-free tv))
-  )
-
+  key)
 
 (defun gtk-list-store-set (lstore iter types-lst data-lst)
   (with-g-value (value)
@@ -156,10 +146,10 @@
       (gvi :post-set))))
 
 (defun gtk-tree-store-new (col-types)
-  (let ((gtk-types (ffx:fgn-alloc :int (length col-types))))
+  (let ((gtk-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))
     (loop for type in col-types
           for tn upfrom 0
-          do (setf (ffx:elti gtk-types tn) (as-gtk-type type)))
+          do (setf (cffi:mem-aref gtk-types :int tn) (coerce (as-gtk-type type) 'integer)))
     (gtk-tree-store-newv (length col-types) gtk-types)))
 
 (defun gtk-tree-store-set (tstore iter types-lst data-lst)
@@ -234,7 +224,7 @@
     (DECLARE (ignorable tree-column data))
     (ukt:trc nil "gtv-render-cell (callback)> entry"
       tree-column cell-renderer model iter data)
-    (let ((return-buffer (ffx:fgn-alloc :int 16)))
+    (let ((return-buffer (cffi:foreign-alloc :int :count 16)))
       (gtk-tree-model-get model iter col
         return-buffer -1)
       (let* ((returned-value (deref-pointer-runtime-typed return-buffer
@@ -267,9 +257,8 @@
         (when cell-attrib-f 
           (loop for property in (parse-cell-attrib (funcall cell-attrib-f item-value))
               do (apply #'gtk-object-set-property cell-renderer property)))
-        (when ret$
-          (uffi:free-foreign-object ret$))
-        (ffx:fgn-free return-buffer)))
+        (when ret$ (cffi:foreign-free ret$))
+        (cffi:foreign-free return-buffer)))
     1))
 
 (defun gtk-file-chooser-get-filenames-strs (file-chooser)



From pdenno at common-lisp.net  Sat Feb 11 03:52:17 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 21:52:17 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060211035217.8B43D5E010@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv32692/public_html

Modified Files:
	index.html 
Log Message:
Added news of update to use CFFI 0.9, removal of all Hello-C code.

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/01/04 16:44:42	1.17
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/11 03:52:17	1.18
@@ -74,6 +74,7 @@
 <h1 id='news'>News</h1>
 
 <ul>
+  <li> <strong>2006-02-10</strong> Source on CVS is updated to use CFFI 0.9 and all Hello-C code has been eliminated.</li>
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port



From pdenno at common-lisp.net  Sat Feb 11 04:02:35 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 22:02:35 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060211040235.A72586700E@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv1991/public_html

Modified Files:
	faq.html 
Log Message:
Updated comments about Hello-C and CLISP.

--- /project/cells-gtk/cvsroot/public_html/faq.html	2005/10/08 15:03:29	1.11
+++ /project/cells-gtk/cvsroot/public_html/faq.html	2006/02/11 04:02:35	1.12
@@ -30,8 +30,6 @@
       <ul>
       <li><a href="#q1">What is Cells-GTK?</a></li>
       <li><a href="#q2">What is Cells?</a></li>
-      <li><a href="#q3">Why is the Clisp distribution separate?</a></li>
-      <li><a href="#q4">If Cells-GTK uses UFFI, what is this "hello-C" thing about?</a></li>
       <li><a href="#q5">Did anyone really ask these questions?</a></li>
       <li><a href="#q6">What GTK Widgets are implemented in cells-gtk?</a></li>
       <li><a href="#q7">Do I have to use cells?</a></li>
@@ -55,9 +53,8 @@
 <strong id="q1">Q: What is Cells-GTK?</strong><p/>
 <strong>A:</strong> Cells-GTK is a lisp binding of GTK written by Vasilis Margioulas. It uses the 
 Cells system, a sort of constraint propagation system written by kenny tilton.
-(see "What is Cells?"). As of this writing Cells-GTK runs under Allegro, Lispworks 
-and CMUCL. A separate distribution (not quite up to date with the former) runs 
-on CLisp.
+(see "What is Cells?"). As of this writing Cells-GTK runs under Allegro, Lispworks, CMUCL, SBCL
+and CLISP. 
 <p/>
 <strong id="q2">Q: What is Cells?</strong><p/>
 <strong>A:</strong> From the Cells website: "Cells is a mature, stable extension to CLOS that allows you 
@@ -116,15 +113,6 @@
 
 <p/>
 
-<strong id="q3">Q: Why is the Clisp distribution separate?</strong><p/>
-<strong>A:</strong> Because as of this writing, UFFI, which Cells-GTK uses, doesn't support CLISP.
-<p/>
-<strong id="q4">Q: If Cells-GTK uses UFFI, what is this "hello-C" thing about?</strong><p/>
-<strong>A:</strong> Hello-C is kenny tilton's branch of UFFI to address the fact that
-UFFI doesn't support CLisp. Hello-c does a few extra things as well. Whether we
-stick with this approach, whether we can add UFFI support for CLisp, etc....time 
-will tell.
-<p/>
 <strong id="q5">Q: Did anyone really ask these questions?</strong><p/>
 <strong>A:</strong> Naw, I (Peter Denno) am just talking to myself. 
 <p/>
@@ -369,7 +357,7 @@
 <address><a href="mailto:peter.denno at nist.gov">Peter Denno</a></address>
 <!-- Created: Thu Mar  3 18:45:35 EST 2005 -->
 <!-- hhmts start -->
-Last modified: 2005-10-08
+Last modified: 2006-02-10
 <!-- hhmts end -->
 </div>
 </body>



From pdenno at common-lisp.net  Sat Feb 11 04:39:16 2006
From: pdenno at common-lisp.net (pdenno)
Date: Fri, 10 Feb 2006 22:39:16 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060211043916.F2CE97400D@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv5263/public_html

Modified Files:
	faq.html 
Log Message:
Added FAQ about delivery.

--- /project/cells-gtk/cvsroot/public_html/faq.html	2006/02/11 04:02:35	1.12
+++ /project/cells-gtk/cvsroot/public_html/faq.html	2006/02/11 04:39:16	1.13
@@ -30,6 +30,7 @@
       <ul>
       <li><a href="#q1">What is Cells-GTK?</a></li>
       <li><a href="#q2">What is Cells?</a></li>
+      <li><a href="#q3">What is required to deliver executables?</a></li>
       <li><a href="#q5">Did anyone really ask these questions?</a></li>
       <li><a href="#q6">What GTK Widgets are implemented in cells-gtk?</a></li>
       <li><a href="#q7">Do I have to use cells?</a></li>
@@ -113,6 +114,22 @@
 
 <p/>
 
+<strong id="q3">Q: What is required to deliver executables?</strong><p/>
+There is only one data point that I know of with respect to this; I created an Win32 .exe
+using Lispworks. The code is available for anyone who might what to take a look (email me, it's
+not on a server anywhere). The .exe is available too.<p/>
+Key aspects of the design:
+  <ul>
+    <li>I included with the application the Cells-GTK libraries, so that the user didn't have
+        to mess around with finding and installing those.
+    <li>I used the <a href='http://nsis.sourceforge.net/Main_Page'>NSIS</a> open source installer 
+        creation tool, which works nicely and, importantly, allowed me to add to the PATH variable. 
+        My software looks for GTK on the path to determine where it was installed. It 
+        then set *gtk-lib-path*.
+    <li>That's it!
+  </ul>
+
+
 <strong id="q5">Q: Did anyone really ask these questions?</strong><p/>
 <strong>A:</strong> Naw, I (Peter Denno) am just talking to myself. 
 <p/>



From pdenno at common-lisp.net  Thu Feb 16 18:01:42 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:01:42 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180142.42FA44C002@common-lisp.net>

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

Modified Files:
	gtk-button.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-button.lisp	2004/12/06 20:03:00	1.1
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-button.lisp	2006/02/16 18:01:42	1.2
@@ -18,51 +18,58 @@
 
 (in-package :gtk-ffi)
 
-
 (def-gtk-lib-functions :gtk
-  ;;button
-  (gtk-button-new ()
-     c-pointer)
-  (gtk-button-set-label ((button c-pointer)
-			 (label c-string)))
-  (gtk-button-set-relief ((button c-pointer)
-			  (style int)))
-  (gtk-button-set-use-stock ((button c-pointer)
-			     (use-stock boolean)))
-  ;;toggle-button
-  (gtk-toggle-button-new ()
-     c-pointer)
-  (gtk-toggle-button-set-mode ((button c-pointer)
-			       (draw-indicator boolean)))
-  (gtk-toggle-button-set-active ((button c-pointer)(active boolean)))
-  (gtk-toggle-button-get-active ((button c-pointer))
-     boolean)
-  ;;check-button
-  (gtk-check-button-new ()
-     c-pointer)
-  ;;radio-button
-  (gtk-radio-button-new ((gslist c-pointer))
-     c-pointer)
-  (gtk-radio-button-new-from-widget ((radio-group c-pointer))
-     c-pointer)
-  
-  ;;spin-button
-  (gtk-spin-button-new ((adjustment c-pointer)
-			(climb-rate double-float)
-			(digits uint))
-    c-pointer)
-  (gtk-spin-button-new-with-range ((minval double-float)
-				   (maxval double-float)
-				   (step double-float))
-    c-pointer)
-  (gtk-spin-button-set-value ((spin-button c-pointer)
-			      (value double-float)))
-  (gtk-spin-button-get-value ((spin-button c-pointer))
-     double-float)
-  (gtk-spin-button-get-value-as-int ((spin-button c-pointer))
-     int)
-  (gtk-spin-button-set-wrap ((spin-button c-pointer)
-			     (wrap boolean))))
+  (gtk-button-new :pointer ())
+  (gtk-button-set-label
+   :void
+   ((button :pointer) (label :gtk-string)))
+  (gtk-button-set-relief
+   :void
+   ((button :pointer) (style :int)))
+  (gtk-button-set-use-stock
+   :void
+   ((button :pointer) (use-stock :gtk-boolean)))
+  (gtk-toggle-button-new :pointer ())
+  (gtk-toggle-button-set-mode
+   :void
+   ((button :pointer)
+    (draw-indicator :gtk-boolean)))
+  (gtk-toggle-button-set-active
+   :void
+   ((button :pointer) (active :gtk-boolean)))
+  (gtk-toggle-button-get-active
+   :gtk-boolean
+   ((button :pointer)))
+  (gtk-check-button-new :pointer ())
+  (gtk-radio-button-new
+   :pointer
+   ((gslist :pointer)))
+  (gtk-radio-button-new-from-widget
+   :pointer
+   ((radio-group :pointer)))
+  (gtk-spin-button-new
+   :pointer
+   ((adjustment :pointer)
+    (climb-rate :double)
+    (digits :unsigned-int)))
+  (gtk-spin-button-new-with-range
+   :pointer
+   ((minval :double)
+    (maxval :double)
+    (step :double)))
+  (gtk-spin-button-set-value
+   :void
+   ((spin-button :pointer) (value :double)))
+  (gtk-spin-button-get-value
+   :double
+   ((spin-button :pointer)))
+  (gtk-spin-button-get-value-as-int
+   :int
+   ((spin-button :pointer)))
+  (gtk-spin-button-set-wrap
+   :void
+   ((spin-button :pointer) (wrap :gtk-boolean))))
+
 
 #+debugthis
 (gtk-toggle-button-get-active ((button c-pointer))
@@ -73,4 +80,3 @@
                   :ARGUMENTS ((BUTTON C-POINTER))
                   :RETURN-TYPE BOOLEAN
                   :CALL-DIRECT T)
-



From pdenno at common-lisp.net  Thu Feb 16 18:02:18 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:02:18 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180218.11D0B4C002@common-lisp.net>

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

Modified Files:
	gtk-core.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/02/11 03:40:26	1.6
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/02/16 18:02:17	1.7
@@ -18,35 +18,34 @@
 
 (in-package :gtk-ffi)
 
+
 (def-gtk-lib-functions :glib
-  (g-free ((data c-pointer)))
-  (g-slist-free ((lst c-pointer)))
-  (g-timeout-add ((milliseconds uint)
-		  (func #.(callback-function ((data c-pointer))
-			    boolean))
-		  (data c-pointer))
-     uint)
-  (g-locale-from-utf8 ((utf8-string c-pointer)
-		       (len sint32)
-		       (bytes-read c-pointer)
-		       (bytes-written c-pointer)
-		       (gerror c-pointer))
-   c-string :malloc-free)
-  (g-locale-to-utf8 ((local-string c-string)
-		     (len sint32)
-		     (bytes-read c-pointer)
-		     (bytes-written c-pointer)
-		     (gerror c-pointer))
-   c-pointer))
+  (g-free :void ((data :pointer)))
+  (g-slist-free :void ((lst :pointer)))
+  (g-timeout-add :unsigned-int
+		 ((milliseconds :unsigned-int)
+		  (func :pointer)
+		  (data :pointer)))
+  (g-locale-from-utf8 :gtk-string
+		      ((utf8-string :pointer)
+		       (len :int)
+		       (bytes-read :pointer)
+		       (bytes-written :pointer)
+		       (gerror :pointer)))
+  (g-locale-to-utf8 :pointer
+		    ((local-string :gtk-string)
+		     (len :int)
+		     (bytes-read :pointer)
+		     (bytes-written :pointer)
+		     (gerror :pointer))))
 
-(def-gtk-lib-functions :gthread
-  (g-thread-init ((vtable c-pointer))))
+(def-gtk-lib-functions :gthread (g-thread-init :void ((vtable :pointer))))
 
 (def-gtk-lib-functions :gdk
-  (gdk-threads-init ())
-  (gdk-threads-enter ())
-  (gdk-threads-leave ())
-  (gdk-flush ()))
+  (gdk-threads-init :void ())
+  (gdk-threads-enter :void ())
+  (gdk-threads-leave :void ())
+  (gdk-flush :void ()))
 
 (def-union g-value-data
   (v-int :int)
@@ -92,49 +91,38 @@
 
 (def-gtk-lib-functions :gobject
   ;; callbacks
-  (g-cclosure-new ((callback-f #.(callback-function ((widget c-pointer)
-						     (event c-pointer)
-						     (data c-pointer))
-				   boolean))
-		   (user-data c-pointer)
-		   (destroy-data c-pointer))
-      c-pointer)
-  (g-cclosure-new-swap ((callback-f #.(callback-function ((widget c-pointer)
-							  (event c-pointer)
-							  (data c-pointer))
-				        boolean))
-			(user-data c-pointer)
-			(destroy-data c-pointer))
-      c-pointer)
-  (g-signal-connect-closure ((instance c-pointer)
-                             (detailed-signal c-string)
-                             (closure c-pointer)
-                             (after boolean)
-                             )
-    ulong nil nil)
-  (g-object-set-valist ((object c-pointer)
-			(first-prop c-string)
-			(varargs c-pointer)))
-  (g-object-set-property ((object c-pointer)
-                          (property-name c-string)
-                          (value c-pointer)))
-  (g-value-init ((value c-pointer)
-                 (type ulong))
-    c-pointer)
-  (g-value-unset ((value c-pointer)))
-  (g-value-set-string ((value c-pointer)
-		       (str c-string)))
-  (g-value-set-int ((value c-pointer)
-		    (int int)))
-  (g-value-set-long ((value c-pointer)
-		     (long long)))
-  (g-value-set-boolean ((value c-pointer)
-			(bool boolean))
-    nil nil nil)
-  (g-value-set-float ((value c-pointer)
-		      (float single-float)))
-  (g-value-set-double ((value c-pointer)
-		       (double double-float))))
-
-
-
+  (g-cclosure-new :pointer
+		  ((callback-f :pointer)
+		   (user-data :pointer)
+		   (destroy-data :pointer)))
+  (g-cclosure-new-swap :pointer
+		       ((callback-f :pointer)
+			(user-data :pointer)
+			(destroy-data :pointer)))
+  (g-signal-connect-closure :unsigned-long
+			    ((instance :pointer)
+			     (detailed-signal :gtk-string)
+			     (closure :pointer)
+			     (after :gtk-boolean)))
+  (g-object-set-valist :void
+		       ((object :pointer)
+			(first-prop :gtk-string)
+			(varargs :pointer)))
+  (g-object-set-property :void
+			 ((object :pointer)
+			  (property-name :gtk-string)
+			  (value :pointer)))
+  (g-value-init :pointer ((value :pointer)
+			  (type :unsigned-long)))
+  (g-value-unset :void ((value :pointer)))
+  (g-value-set-string :void
+		      ((value :pointer) (str :gtk-string)))
+  (g-value-set-int :void ((value :pointer) (int :int)))
+  (g-value-set-long :void ((value :pointer) (long :long)))
+  (g-value-set-boolean :void
+		       ((value :pointer)
+			(bool :gtk-boolean)))
+  (g-value-set-float :void
+		     ((value :pointer) (float :float)))
+  (g-value-set-double :void
+		      ((value :pointer) (double :double))))



From pdenno at common-lisp.net  Thu Feb 16 18:02:59 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:02:59 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180259.5AD0D4C002@common-lisp.net>

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

Modified Files:
	gtk-ffi.asd 
Log Message:
Now loads my utils too.

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/02/11 03:44:32	1.11
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/02/16 18:02:59	1.12
@@ -4,16 +4,7 @@
 ;;; Two steps:
 ;;;---------------------
 
-(defvar *gtk-lib-path* nil)
-
-;;; Step 1 -- If you are not using Linux nor BSD and the GTK libs are not 
-;;;           in the places specified below, adjust these.
-
-;;; Specify for Lispworks (definitely), other maybe.
-#+macosx(setf *gtk-lib-path* "/sw/lib/")
-#+(or win32 mswindows)(setf *gtk-lib-path* "E:/GTK/bin/")
-#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/usr/lib/") 
-;#-(or macosx win32 mswindows)(setf *gtk-lib-path* "/opt/gnome/lib/")  ; For my SuSE machine
+;;; Step 1 -- Do nothing. (UFFI/Hello-C had a "Step 1," CFFI doesn't.)
 
 ;;; Step 2 -- If you built or downloaded the libcellsgtk library, uncomment the next line.
 (pushnew :libcellsgtk *features*)
@@ -22,7 +13,8 @@
   :name "gtk-ffi"
   :depends-on (:cells :cffi :cffi-uffi-compat)
   :components
-  ((:file "gtk-ffi")
+  ((:file "utils")
+   (:file "gtk-ffi" :depends-on ("utils"))
    (:file "gtk-core" :depends-on ("gtk-ffi"))
    (:file "gtk-other" :depends-on ("gtk-ffi"))
    (:file "gtk-button" :depends-on ("gtk-ffi"))



From pdenno at common-lisp.net  Thu Feb 16 18:04:29 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:04:29 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180429.24D3A4C002@common-lisp.net>

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

Modified Files:
	gtk-ffi.lisp 
Log Message:
Now native CFFI, use CFFI type translation. Reworked macros def-gtk-lib-function, def-gtk-function

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/11 03:45:55	1.16
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/16 18:04:29	1.17
@@ -16,16 +16,56 @@
  
 |#
 
-
-(defpackage :gtk-ffi (:use :common-lisp :uffi))
+(defpackage :gtk-ffi (:use :common-lisp :pod :uffi)) ; pod remove uffi
 
 (in-package :gtk-ffi)
 
-(defconstant c-null (make-null-pointer '(* :void)))
-(defconstant c-null-int (make-null-pointer :int))
+;;; POD throw-away utility
+(defun gtk-lib2cffi (body)
+  "Convert hello-c to uffi to cffi types. Swap order of arguments."
+  (flet ((convert-type (type)
+	  (case type
+	    (c-string :gtk-string)
+	    (boolean :gtk-boolean)
+	    (t (cffi-uffi-compat::convert-uffi-type (ffi-to-uffi-type type))))))
+  (dbind (ignore module &rest funcs) body
+     (pprint `(,ignore 
+	       ,module
+	       ,@(mapcar
+		  #'(lambda (f)
+		      (dbind (name args &optional return-type) f
+			     ` (,name 
+				    ,(if return-type
+					 (convert-type return-type)
+				       :void)
+				    ,(mapcar #'(lambda (a)
+						 (list
+						  (car a)
+						  (convert-type (cadr a))))
+					     args))))
+		      funcs))
+	     *standard-output*))))
+
 
+(defconstant +c-null+ (cffi:null-pointer)) 
 (defvar *gtk-debug* nil)
 
+;;; ==============  Define CFFI types, and their translations.... 
+(cffi:defctype :gtk-string :pointer :documentation "string type for cffi type translation")
+(cffi:defctype :gtk-boolean :pointer :documentation "boolean type for cffi type translation")
+
+(defmethod cffi:translate-to-foreign (value (type (eql :gtk-boolean)))
+  (cffi:make-pointer (if value 1 0)))
+
+(defmethod cffi:translate-from-foreign (value (type (eql :gtk-boolean)))
+  (not (zerop (cffi::pointer-address value)))) ; pod strange!
+
+(defmethod cffi:translate-to-foreign (value (type (eql :gtk-string)))
+  (when (null value) (setf value "")) ; pod ??? 
+  (cffi:foreign-string-alloc value))
+
+(defmethod cffi:translate-from-foreign (value (type (eql :gtk-string)))
+  (cffi:foreign-string-to-lisp value))
 
 (defun int-slot-indexed (obj obj-type slot index)
   (declare (ignorable obj-type))
@@ -40,53 +80,69 @@
          '(:array :int) index)
     new-value))
 
+(cffi:define-foreign-library 'gobject
+  (:linux "libgobject-2.0.so")
+  (:win32 "libgobject-2.0-0.dll")
+  (:macosx "libgobject-2.0-0.dylib"))
+
+(cffi:define-foreign-library :glib
+  (:linux "libglib-2.0.so")
+  (:win32 "libglib-2.0-0.dll")
+  (:macosx "libglib-2.0-0.dylib"))
+
+(cffi:define-foreign-library :gthread
+  (:linux "libgthread-2.0.so")
+  (:win32 "libgthread-2.0-0.dll")
+  (:macosx "libgthread-2.0-0.dylib"))
+
+(cffi:define-foreign-library :gdk
+  (:linux "libgdk-x11-2.0.so")
+  (:win32 "libgdk-win32-2.0-0.dll")
+  (:macosx "libgdk-win32-2.0-0.dylib")) ; pod ???
+
+(cffi:define-foreign-library :gtk
+  (:linux "libgtk-x11-2.0.so")
+  (:win32 "libgtk-win32-2.0-0.dll")
+  (:macosx "libgtk-win32-2.0-0.dylib")) ; pod ???
+
+#+libcellsgtk
+(cffi:define-foreign-library :cgtk
+  (:linux "libcellsgtk.so")
+  (:win32 "libcellsgtk.dll")
+  (:macosx "libcellsgtk.dylib"))
+
+;;; After doing this, should be able to do (g-thread-init c-null)
+;;; The above define-foreigh-library appears to be useless (doesn't
+;;; work through the symbols) use the names. 
+(defun load-gtk-libs ()
+  (handler-bind ((style-warning #'muffle-warning))
+    (cffi:load-foreign-library #+linux "libgobject-2.0.so" 
+			       #+win32 "libgobject-2.0-0.dll" 
+			       #+macosx "libgobject-2.0-0.dylib")
+    (cffi:load-foreign-library #+linux "libglib-2.0.so" 
+			       #+win32 "libglib-2.0-0.dll" 
+			       #+macosx "libglib-2.0-0.dylib")
+    (cffi:load-foreign-library #+linux "libgthread-2.0.so" 
+			       #+win32 "libgthread-2.0-0.dll" 
+			       #+macosx "libgthread-2.0-0.dylib")
+    (cffi:load-foreign-library #+linux "libgdk-x11-2.0.so" 
+			       #+win32 "libgdk-win32-2.0-0.dll" 
+			       #+macosx "libgdk-win32-2.0-0.dylib")
+    (cffi:load-foreign-library #+linux "libgtk-x11-2.0.so" 
+			       #+win32 "libgtk-win32-2.0-0.dll" 
+			       #+macosx "libgtk-win32-2.0-0.dylib")
+    #+libcellsgtk
+    (cffi:load-foreign-library #+linux "libcellsgtk.so" 
+			       #+win32 "libcellsgtk.dll" 
+			       #+macosx "libcellsgtk.dylib")))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(c-null c-null-int int-slot-indexed load-gtk-libs))
+  (export '(+c-null+ int-slot-indexed load-gtk-libs))
   (defun gtk-function-name (lisp-name)
     (substitute #\_ #\- lisp-name))
-  (defun libname (lib)
-    (ecase lib
-      (:gobject #+win32 "libgobject-2.0-0.dll"
-		#-win32 "libgobject-2.0.so")
-      (:glib #+win32 "libglib-2.0-0.dll")
-      (:gthread #+win32 "libgthread-2.0-0.dll")
-      (:gdk #+win32 "libgdk-win32-2.0-0.dll")
-      (:gtk #+win32 "libgtk-win32-2.0-0.dll")
-      #+libcellsgtk (:cgtk  "libcellsgtk.dll")))
-  (defun load-gtk-libs ()
-    (macrolet ((loadit (libname module) 
-		       `(handler-bind ((style-warning #'muffle-warning))
-			  (uffi:load-foreign-library 		 
-			   (concatenate 'string cl-user::*gtk-lib-path* ,libname)
-			   :force-load #+lispworks t #-lispworks nil
-			   :module ,(string module)))))
-      #+(or win32 mswindows)
-      (progn 
-	(loadit "libgobject-2.0-0.dll" :gobject)
-	(loadit "libglib-2.0-0.dll" :glib)
- 	(loadit "libgthread-2.0-0.dll" :gthread)
-	(loadit "libgdk-win32-2.0-0.dll" :gdk)
-	(loadit "libgtk-win32-2.0-0.dll" :gtk)
-	#+libcellsgtk(loadit "libcellsgtk.dll" :cgtk))
-      #+macosx
-      (progn
-	(loadit "libgobject-2.0-0.dynlib" :gobject)
-	(loadit "libglib-2.0-0.dynlib" :glib)
-	(loadit "libgthread-2.0-0.dynlib" :gthread)
-	(loadit "libgdk-win32-2.0-0.dynlib" :gdk)
-	(loadit "libgtk-win32-2.0-0.dynlib" :gtk)
-	#+libcellsgtk(loadit "libcellsgtk.dynlib" :cgtk))
-      #-(or macosx win32 mswindows)
-      (progn 
-	(loadit "libgobject-2.0.so" :gobject)
-	(loadit "libglib-2.0.so" :glib)
-	(loadit "libgthread-2.0.so" :gthread)
-	(loadit "libgdk-x11-2.0.so" :gdk)
-	(loadit "libgtk-x11-2.0.so" :gtk)
-	#+libcellsgtk(loadit "libcellsgtk.so" :cgtk))))
-  #+cmu(load-gtk-libs)
-  #+clisp(load-gtk-libs)
+
+  #+(or cmu clisp)(load-gtk-libs)
+
   (defun ffi-to-uffi-type (clisp-type)
     
     (if (consp clisp-type)
@@ -110,85 +166,41 @@
 		(single-float :float)
 		(double-float :double)
 		(otherwise clisp-type))))
+) ;eval
 
-  (defun ffi-to-native-type (ffi-type)
-    (uffi::convert-from-uffi-type
-     (ffi-to-uffi-type ffi-type) :type))) ;; END eval-when
-
-(defmacro def-gtk-function (library name &key arguments return-type 
-                             (return-type-allocation :none)
-                             (call-direct t))
-  (declare (ignore return-type-allocation call-direct))
-  
+(defmacro def-gtk-function (library name return-type arguments)
+  (declare (ignore library))
   (let* ((gtk-name$ (gtk-function-name (string-downcase (symbol-name name))))
          (gtk-name (intern (string-upcase gtk-name$))))
-    (let ((arg-info
-           (loop for arg in arguments
-               for gsym = (gensym)
-               if (eql 'c-string (cadr arg))
-               collect (car arg) into arg$s
-               and collect gsym into gsyms
-               and collect gsym into pass-args
-               else if (eql 'boolean (cadr arg))
-               collect `(if ,(car arg) 1 0) into pass-args
-               else if (eql 'c-pointer (cadr arg))
-               collect `(or ,(car arg) c-null) into pass-args
-               else collect (car arg) into pass-args
-               finally (return (list (mapcar 'list gsyms arg$s)
-                                 pass-args)))))
-      `(progn
-	  (uffi:def-function (,gtk-name$ ,gtk-name)
-	     ,(mapcar (lambda (name-type)
-			(destructuring-bind (name type) name-type
-			  (list name (ffi-to-uffi-type type))))
-		      arguments)
-	     :module ,(string library)
-	     :returning ,(ffi-to-uffi-type return-type))
-         (defun ,name ,(mapcar 'car arguments)
-           (when *gtk-debug*
-             ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
-                          (string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
-                `(print (list ,(symbol-name name) :before ,@(mapcar 'car arguments)))))
-           (prog1
-               ,(let ((bodyform `(with-cstrings
-                                     ,(car arg-info)
-                                   (,gtk-name ,@(cadr arg-info)))))
-                  (if (eql return-type 'boolean)
-                      `(not (zerop ,bodyform))
-		    (if (eql return-type 'c-string)
-		      `(convert-from-cstring ,bodyform)
-		      bodyform)
-		    ))
-	          
-             (when *gtk-debug*
-               ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
-                            (string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
-                  `(print (list ,(symbol-name name) :after ,@(mapcar 'car arguments)))))))
-         (eval-when (compile load eval)
-           (export ',name))))))
+    `(progn
+       (cffi:defcfun (,gtk-name$ ,gtk-name) ,return-type , at arguments)
+       (defun ,name ,(mapcar 'car arguments)
+	 (when *gtk-debug*
+	   ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
+			(string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
+	      `(format *trace-output* "~%before (~A ~{~A~^ ~})" 
+		       ,(string-downcase (string name)) (list ,@(mapcar 'car arguments)))))
+	 (prog1
+	     (,gtk-name ,@(mapcar #'car arguments))
+	   (when *gtk-debug*
+	     ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
+			  (string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
+	      `(format *trace-output* "~%after (~A ~{~A~^ ~})" 
+		       ,(string-downcase (string name)) (list ,@(mapcar 'car arguments)))))))
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+	 (export ',name)))))
 
 (defmacro def-gtk-lib-functions (library &rest functions)
   `(progn
      ,@(loop for function in functions collect
-             (destructuring-bind (name (&rest args)
-                                   &optional return-type
-                                   return-type-allocation
-                                   (call-direct t)) function
-               `(def-gtk-function ,library ,name
-                  ,@(when args `(:arguments ,args))
-                  :return-type ,return-type
-                  ,@(when return-type-allocation
-                      `(:return-type-allocation ,return-type-allocation))
-                  :call-direct ,call-direct)))))
-
+             (destructuring-bind (name return-type (&rest args)) function
+               `(def-gtk-function ,library ,name ,return-type ,args)))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defmacro callback-function ((&rest arguments) &optional return-type)
     (declare (ignore arguments return-type))
         `'c-pointer))
 
-
-
 (defmacro def-c-struct (struct-name &rest fields)
   (let ((slot-defs (loop for field in fields
                          collecting (destructuring-bind (name type) field
@@ -313,7 +325,6 @@
     (32 :window_state)
     (33 :setting)))
 
-
 (uffi:def-struct list-boolean
     (value :unsigned-int)
   (end :pointer-void))
@@ -363,12 +374,11 @@
 (defmacro with-tree-iter ((iter-var) &body body)
   `(uffi:with-foreign-object (,iter-var 'gtk-tree-iter)
      (setf (get-slot-value ,iter-var 'gtk-tree-iter 'stamp) 0)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data) c-null)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data2) c-null)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data3) c-null)
+     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data) +c-null+)
+     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data2) +c-null+)
+     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data3) +c-null+)
      , at body))
 
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun as-gtk-type-name (type)
     (ecase type



From pdenno at common-lisp.net  Thu Feb 16 18:05:05 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:05:05 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180505.341944D014@common-lisp.net>

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

Modified Files:
	gtk-list-tree.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-list-tree.lisp	2006/01/03 19:08:51	1.4
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-list-tree.lisp	2006/02/16 18:05:04	1.5
@@ -19,158 +19,177 @@
 (in-package :gtk-ffi)
 
 (def-gtk-lib-functions :gtk
-  ;;list-store  
-  (gtk-list-store-newv ((n-columns int)
-			(col-types c-pointer))
-    c-pointer)
-  (gtk-list-store-set-valist ((store c-pointer)
-			      (iter c-pointer)
-			      (data c-pointer)))
-  (gtk-list-store-set-value ((store c-pointer)
-			     (iter c-pointer)
-			     (column int)
-			     (value c-pointer)))
-  (gtk-list-store-append ((list-store c-pointer)
-			  (iter c-pointer)))
-  (gtk-list-store-clear ((list-store c-pointer)))
-
-  ;;tree-store
-  (gtk-tree-store-newv ((n-columns int)
-			(col-types c-pointer))
-    c-pointer)
-  (gtk-tree-store-set-valist ((store c-pointer)
-			      (iter c-pointer)
-			      (data c-pointer)))
-  (gtk-tree-store-set-value ((store c-pointer)
-			     (iter c-pointer)
-			     (column int)
-			     (value c-pointer)))
-  (gtk-tree-store-append ((list-store c-pointer)
-			  (iter c-pointer)
-			  (parent c-pointer)))
-  (gtk-tree-store-clear ((list-store c-pointer)))
-
-  ;;tree-view
-  (gtk-tree-view-new ()
-    c-pointer)
-  (gtk-tree-view-set-model ((tree-view c-pointer)
-			    (model c-pointer)))
-  (gtk-tree-view-insert-column ((tree-view c-pointer)
-				(column c-pointer)
-				(pos int))
-    int)
-  (gtk-tree-view-get-selection ((tree-view c-pointer))
-     c-pointer)
-  (gtk-tree-view-get-path-at-pos ((tree-view c-pointer)
-                                  (x int)
-                                  (y int)
-                                  (path c-pointer)
-                                  (column c-pointer)
-                                  (cell-x c-pointer)
-                                  (cell-y c-pointer))
-     boolean)
-  (gtk-tree-view-widget-to-tree-coords ((tree-view c-pointer)
-                                        (wx int)
-                                        (wy int)
-                                        (tx c-pointer)
-                                        (ty c-pointer)))
-  (gtk-tree-view-tree-to-widget-coords ((tree-view c-pointer)
-                                        (wx int)
-                                        (wy int)
-                                        (tx c-pointer)
-                                        (ty c-pointer)))
-  (gtk-tree-view-expand-all ((tree-view c-pointer)))
-
+  ;;list-store
+  (gtk-list-store-newv :pointer
+		       ((n-columns :int)
+			(col-types :pointer)))
+  (gtk-list-store-set-valist :void
+			     ((store :pointer)
+			      (iter :pointer)
+			      (data :pointer)))
+  (gtk-list-store-set-value :void
+			    ((store :pointer)
+			     (iter :pointer)
+			     (column :int)
+			     (value :pointer)))
+  (gtk-list-store-append :void
+			 ((list-store :pointer)
+			  (iter :pointer)))
+  (gtk-list-store-clear :void
+			((list-store :pointer)))
+  ;;tre-store
+  (gtk-tree-store-newv :pointer
+		       ((n-columns :int)
+			(col-types :pointer)))
+  (gtk-tree-store-set-valist :void
+			     ((store :pointer)
+			      (iter :pointer)
+			      (data :pointer)))
+  (gtk-tree-store-set-value :void
+			    ((store :pointer)
+			     (iter :pointer)
+			     (column :int)
+			     (value :pointer)))
+  (gtk-tree-store-append :void
+			 ((list-store :pointer)
+			  (iter :pointer)
+			  (parent :pointer)))
+  (gtk-tree-store-clear :void
+			((list-store :pointer)))
+  ;;tre-view
+  (gtk-tree-view-new :pointer ())
+  (gtk-tree-view-set-model :void
+			   ((tree-view :pointer)
+			    (model :pointer)))
+  (gtk-tree-view-insert-column :int
+			       ((tree-view
+				 :pointer)
+				(column :pointer)
+				(pos :int)))
+  (gtk-tree-view-get-selection :pointer
+			       ((tree-view
+				 :pointer)))
+  (gtk-tree-view-get-path-at-pos :gtk-boolean
+				 ((tree-view :pointer)
+				  (x :int)
+				  (y :int)
+				  (path :pointer)
+				  (column :pointer)
+				  (cell-x :pointer)
+				  (cell-y :pointer)))
+  (gtk-tree-view-widget-to-tree-coords :void
+				       ((tree-view :pointer)
+					(wx :int)
+					(wy :int)
+					(tx :pointer)
+					(ty :pointer)))
+  (gtk-tree-view-tree-to-widget-coords :void
+				       ((tree-view :pointer)
+					(wx :int)
+					(wy :int)
+					(tx :pointer)
+					(ty :pointer)))
+  (gtk-tree-view-expand-all :void
+			    ((tree-view :pointer)))
   ;;tree-iter
-  (gtk-tree-iter-free ((iter c-pointer)))
-
+  (gtk-tree-iter-free :void ((iter :pointer)))
+  (gtk-tree-model-get :void
+		      ((tree-model :pointer)
+		       (iter :pointer)
+		       (column :int)
+		       (data :pointer)
+		       (eof :int)))
   ;;tree-model
-  (gtk-tree-model-get ((tree-model c-pointer)
-		       (iter c-pointer)
-		       (column int)
-		       (data c-pointer)
-		       (eof int)))
-  (gtk-tree-model-get-iter-from-string ((tree-model c-pointer)
-					(iter c-pointer)
-					(path c-string))
-    boolean)				       
-
+  (gtk-tree-model-get-iter-from-string :gtk-boolean
+				       ((tree-model :pointer)
+					(iter :pointer)
+					(path :gtk-string)))
   ;;tree-path
-  (gtk-tree-path-new-from-string ((path c-string))
-    c-pointer)
-  (gtk-tree-path-to-string ((path c-pointer))
-    c-string)
-  (gtk-tree-path-free ((path c-pointer)))
-
+  (gtk-tree-path-new-from-string :pointer
+				 ((path :gtk-string)))
+  (gtk-tree-path-to-string :gtk-string
+			   ((path :pointer)))
+  (gtk-tree-path-free :void ((path :pointer)))
   ;;tree-selection
-   (gtk-tree-selection-set-mode ((sel c-pointer)
-				 (mode int)))
-   (gtk-tree-selection-get-mode ((sel c-pointer))
-     int)
-   (gtk-tree-selection-select-path ((sel c-pointer)
-				    (path c-pointer)))
-   (gtk-tree-selection-get-selected ((sel c-pointer)
-				     (model c-pointer)
-				     (iter c-pointer))
-     boolean)
-   (gtk-tree-selection-selected-foreach ((sel c-pointer)
-					 (callback-f #.(callback-function ((model c-pointer)
-									   (path c-pointer)
-									   (iter c-pointer)
-									   (data c-pointer))))
-					 (data c-pointer)))
-  ;;tree-view-column
-  (gtk-tree-view-column-new ()
-    c-pointer)
-  (gtk-tree-view-column-pack-start ((tree-column c-pointer)
-				    (renderer c-pointer)
-				    (expand boolean))
-    nil nil nil)
-  (gtk-tree-view-column-add-attribute ((tree-column c-pointer)
-				       (renderer c-pointer)
-				       (attribute c-string)
-				       (column int)))
-  (gtk-tree-view-column-set-spacing ((tree-column c-pointer)
-				     (spacing int)))
-  (gtk-tree-view-column-set-visible ((tree-column c-pointer)
-				     (spacing boolean))
-    nil nil nil)
-  (gtk-tree-view-column-set-reorderable ((tree-column c-pointer)
-				       (resizable boolean)))
-  (gtk-tree-view-column-set-sort-column-id ((tree-column c-pointer)
-					    (col-id int)))
-  (gtk-tree-view-column-set-sort-indicator ((tree-column c-pointer)
-					    (resizable boolean)))
-  (gtk-tree-view-column-set-resizable ((tree-column c-pointer)
-				       (resizable boolean)))
-  (gtk-tree-view-column-set-fixed-width ((tree-column c-pointer)
-					 (fixed-width int)))
-  (gtk-tree-view-column-set-min-width ((tree-column c-pointer)
-				       (min-width int)))
-  (gtk-tree-view-column-set-max-width ((tree-column c-pointer)
-					 (max-width int)))
-  (gtk-tree-view-column-set-title ((tree-column c-pointer)
-				   (title c-string)))
-  (gtk-tree-view-column-set-expand ((tree-column c-pointer)
-				    (expand boolean)))
-  (gtk-tree-view-column-set-clickable ((tree-column c-pointer)
-				       (clickable boolean)))
-  (gtk-tree-view-column-set-cell-data-func ((tree-column c-pointer)
-					    (cell-renderer c-pointer)
-					    (func #.(callback-function ((tree-column c-pointer)
-									(cell-renderer c-pointer)
-									(tree-model c-pointer)
-									(iter c-pointer)
-									(data c-pointer))))
-					    (data c-pointer)
-					    (destroy c-pointer)))
-  ;;cell-renderers
-  (gtk-cell-renderer-text-new ()
-    c-pointer)
-  (gtk-cell-renderer-toggle-new ()
-    c-pointer)
-  (gtk-cell-renderer-pixbuf-new ()
-    c-pointer)
-  (gtk-cell-renderer-set-fixed-size ((cell c-pointer)
-                                 (width int)
-                                 (height int))))
+  (gtk-tree-selection-set-mode :void
+			       ((sel :pointer)
+				(mode :int)))
+  (gtk-tree-selection-get-mode :int
+			       ((sel :pointer)))
+  (gtk-tree-selection-select-path :void
+				  ((sel :pointer)
+				   (path :pointer)))
+  (gtk-tree-selection-get-selected :gtk-boolean
+				   ((sel :pointer)
+				    (model :pointer)
+				    (iter :pointer)))
+  (gtk-tree-selection-selected-foreach :void
+				       ((sel :pointer)
+					(callback-f :pointer)
+					(data :pointer)))
+  ;;tre-view-column
+  (gtk-tree-view-column-new :pointer ())
+  (gtk-tree-view-column-pack-start :void
+				   ((tree-column :pointer)
+				    (renderer :pointer)
+				    (expand :gtk-boolean)))
+  (gtk-tree-view-column-add-attribute :void
+				      ((tree-column :pointer)
+				       (renderer :pointer)
+				       (attribute :gtk-string)
+				       (column :int)))
+  (gtk-tree-view-column-set-spacing :void
+				    ((tree-column :pointer)
+				     (spacing :int)))
+  (gtk-tree-view-column-set-visible :void
+				    ((tree-column :pointer)
+				     (spacing :gtk-boolean)))
+  (gtk-tree-view-column-set-reorderable :void
+					((tree-column :pointer)
+					 (resizable :gtk-boolean)))
+  (gtk-tree-view-column-set-sort-column-id :void
+					   ((tree-column :pointer)
+					    (col-id :int)))
+  (gtk-tree-view-column-set-sort-indicator :void
+					   ((tree-column :pointer)
+					    (resizable :gtk-boolean)))
+  (gtk-tree-view-column-set-resizable :void 
+				      ((tree-column :pointer)
+				       (resizable :gtk-boolean)))
+  (gtk-tree-view-column-set-fixed-width :void
+					((tree-column :pointer)
+					 (fixed-width :int)))
+  (gtk-tree-view-column-set-min-width :void
+				      ((tree-column :pointer)
+				       (min-width :int)))
+  (gtk-tree-view-column-set-max-width :void
+				      ((tree-column :pointer)
+				       (max-width :int)))
+  (gtk-tree-view-column-set-title :void
+				  ((tree-column :pointer)
+				   (title :gtk-string)))
+  (gtk-tree-view-column-set-expand :void
+				   ((tree-column :pointer)
+				    (expand :gtk-boolean)))
+  (gtk-tree-view-column-set-clickable :void
+				      ((tree-column
+					:pointer)
+				       (clickable
+					:gtk-boolean)))
+  (gtk-tree-view-column-set-cell-data-func :void
+					   ((tree-column :pointer)
+					    (cell-renderer :pointer)
+					    (func :pointer)
+					    (data :pointer)
+					    (destroy :pointer)))
+  ;;cell-renderer
+  (gtk-cell-renderer-text-new :pointer ())
+  (gtk-cell-renderer-toggle-new :pointer ())
+  (gtk-cell-renderer-pixbuf-new :pointer ())
+  (gtk-cell-renderer-set-fixed-size :void
+				    ((cell
+				      :pointer)
+				     (width :int)
+				     (height
+				      :int))))
+



From pdenno at common-lisp.net  Thu Feb 16 18:05:49 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:05:49 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180549.C781B4D015@common-lisp.net>

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

Modified Files:
	gtk-menu.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-menu.lisp	2005/02/26 22:40:00	1.3
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-menu.lisp	2006/02/16 18:05:49	1.4
@@ -18,108 +18,89 @@
 
 (in-package :gtk-ffi)
 
-(def-gtk-function :gtk gtk-check-menu-item-set-active :arguments
-  ((check-menu c-pointer) (active boolean))
-  :return-type nil :call-direct t)
+(def-gtk-function :gtk gtk-check-menu-item-set-active :void 
+  ((check-menu :pointer) (active :gtk-boolean)))
 
 #+test
 (def-gtk-lib-functions :gtk
   (gtk-check-menu-item-set-active ((check-menu c-pointer)
 				   (active boolean))))
 
-
-
 (def-gtk-lib-functions :gtk
-  ;;menu  
-  (gtk-menu-shell-append ((menu-shell c-pointer)
-			  (child c-pointer)))
-  (gtk-menu-shell-prepend ((menu-shell c-pointer)
-			  (child c-pointer)))
-  (gtk-menu-shell-insert ((menu-shell c-pointer)
-			  (child c-pointer)
-			  (position int)))
-  (gtk-menu-bar-new ()
-    c-pointer)
-
-  (gtk-menu-new ()
-    c-pointer)
-  (gtk-menu-set-title ((menu c-pointer)
-		       (title c-string)))
-  (gtk-menu-attach ((menu c-pointer)
-		    (child c-pointer)
-		    (lattach uint)
-		    (rattach uint)
-		    (tattach uint)
-		    (battach uint)))
-  (gtk-menu-attach-to-widget ((menu c-pointer)
-			      (widget c-pointer)
-			      (func #.(callback-function ((widget c-pointer)
-							  (menu c-pointer))))))
-			      
-  (gtk-menu-popup ((menu c-pointer)
-		   (p-menu-shell c-pointer)
-		   (p-menu-item c-pointer)
-		   (func #.(callback-function ((menu c-pointer)
-					     (x (c-ptr int))
-					     (y (c-ptr int))
-					     (push-in (c-ptr boolean))
-					     (data c-pointer))))
-		   (data c-pointer)
-		   (button uint)
-		   (activate-time uint32)))
-
-  (gtk-menu-item-new ()
-    c-pointer)
-  (gtk-menu-item-new-with-label ((label c-string))
-    c-pointer)
-  (gtk-menu-item-set-right-justified ((menu-item c-pointer)
-				      (right-justified boolean)))
-  (gtk-menu-item-set-submenu ((menu-item c-pointer)
-			      (submenu c-pointer)))
-  (gtk-menu-item-get-submenu ((menu-item c-pointer))
-     c-pointer)
-  (gtk-menu-item-remove-submenu ((menu-item c-pointer)))
-  (gtk-menu-item-set-accel-path ((menu-item c-pointer)
-				 (acell-path c-pointer)))
-  (gtk-accel-map-add-entry ((accel-path c-pointer)
-			    (accel-key uint)
-			    (accel-mods int)))
-  
-  (gtk-check-menu-item-new ()
-    c-pointer)
-  (gtk-check-menu-item-new-with-label ((label c-string))
-    c-pointer)
-  #+above (gtk-check-menu-item-set-active ((check-menu c-pointer)
-				   (active boolean)))
-  (gtk-check-menu-item-get-active ((check-menu c-pointer))
-    boolean)
-
-  (gtk-radio-menu-item-new ((group c-pointer))
-    c-pointer)
-  (gtk-radio-menu-item-new-from-widget ((group c-pointer))
-    c-pointer)
-  (gtk-radio-menu-item-new-with-label ((group c-pointer)
-				       (label c-string))
-    c-pointer)
-  (gtk-radio-menu-item-new-with-label-from-widget ((radio c-pointer)
-						   (label c-string))
-    c-pointer)
-  (gtk-radio-menu-item-get-group ((radio c-pointer))
-    c-pointer)
-  
-  (gtk-image-menu-item-new ()
-    c-pointer)
-  (gtk-image-menu-item-new-with-label ((label c-string))
-    c-pointer)
-  (gtk-image-menu-item-new-from-stock ((stock-id c-string)
-				       (accel-group c-pointer))
-    c-pointer)
-  (gtk-image-menu-item-set-image ((menu-item c-pointer)
-				  (image c-pointer)))
-				  
-
-  (gtk-separator-menu-item-new ()
-    c-pointer)
-  (gtk-tearoff-menu-item-new ()
-    c-pointer))
+  (gtk-menu-shell-append :void
+			 ((menu-shell :pointer)
+			  (child :pointer)))
+  (gtk-menu-shell-prepend :void
+			  ((menu-shell :pointer)
+			   (child :pointer)))
+  (gtk-menu-shell-insert :void
+			 ((menu-shell :pointer)
+			  (child :pointer)
+			  (position :int)))
+  (gtk-menu-bar-new :pointer ())
+  (gtk-menu-new :pointer ())
+  (gtk-menu-set-title :void
+		      ((menu :pointer) (title :gtk-string)))
+  (gtk-menu-attach :void
+		   ((menu :pointer) (child :pointer)
+		    (lattach :unsigned-int)
+		    (rattach :unsigned-int)
+		    (tattach :unsigned-int)
+		    (battach :unsigned-int)))
+  (gtk-menu-attach-to-widget :void
+			     ((menu :pointer)
+			      (widget :pointer)
+			      (func :pointer)))
+  ;;func = (callback-function ((menu c-pointer) (x (c-ptr int)) (y (c-ptr int)) 
+  ;;                           (push-in (c-ptr boolean)) (data c-pointer)))
+  (gtk-menu-popup :void
+		  ((menu :pointer) (p-menu-shell :pointer)
+		   (p-menu-item :pointer) (func :pointer)
+		   (data :pointer) (button :unsigned-int)
+		   (activate-time :unsigned-int)))
+  (gtk-menu-item-new :pointer ())
+  (gtk-menu-item-new-with-label :pointer
+				((label :pointer)))
+  (gtk-menu-item-set-right-justified :void
+				     ((menu-item :pointer)
+				      (right-justified :gtk-boolean)))
+  (gtk-menu-item-set-submenu :void
+			     ((menu-item :pointer)
+			      (submenu :pointer)))
+  (gtk-menu-item-get-submenu :pointer
+			     ((menu-item :pointer)))
+  (gtk-menu-item-remove-submenu :void
+				((menu-item :pointer)))
+  (gtk-menu-item-set-accel-path :void
+				((menu-item :pointer)
+				 (acell-path :pointer)))
+  (gtk-accel-map-add-entry :void
+			   ((accel-path :pointer)
+			    (accel-key :unsigned-int)
+			    (accel-mods :int)))
+  (gtk-check-menu-item-new :pointer ())
+  (gtk-check-menu-item-new-with-label :pointer
+				      ((label :pointer)))
+  (gtk-check-menu-item-get-active :gtk-boolean
+				  ((check-menu :pointer)))
+  (gtk-radio-menu-item-new :pointer ((group :pointer)))
+  (gtk-radio-menu-item-new-from-widget :pointer
+				       ((group :pointer)))
+  (gtk-radio-menu-item-new-with-label :pointer
+				      ((group :pointer)))
+  (gtk-radio-menu-item-new-with-label-from-widget :pointer
+						  ((radio :pointer)
+						   (label :gtk-string)))
+  (gtk-radio-menu-item-get-group :pointer ((radio :pointer)))
+  (gtk-image-menu-item-new :pointer ())
+  (gtk-image-menu-item-new-with-label :pointer ((label :gtk-string)))
+  (gtk-image-menu-item-new-from-stock :pointer
+				      ((stock-id :gtk-string)
+				       (accel-group :pointer)))
+  (gtk-image-menu-item-set-image :void
+				 ((menu-item :pointer)
+				  (image :pointer)))
+  (gtk-separator-menu-item-new :pointer ())
+  (gtk-tearoff-menu-item-new :pointer ()))
+
 



From pdenno at common-lisp.net  Thu Feb 16 18:06:06 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:06:06 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180606.AF5B64D015@common-lisp.net>

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

Modified Files:
	gtk-other.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-other.lisp	2006/02/11 03:46:42	1.12
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-other.lisp	2006/02/16 18:06:06	1.13
@@ -18,757 +18,869 @@
 
 (in-package :gtk-ffi)
 
+
 (def-gtk-lib-functions :gtk
   ;; main-loop
-  (gtk-init ((argc (c-ptr-null int))
-	     (argv c-pointer)))
-  (gtk-init-check ((argc (c-ptr-null int))
-		   (argv c-pointer))
-    boolean)
-  (gtk-events-pending ()
-    boolean)
-  (gtk-main-iteration ()
-    boolean)
-  (gtk-main-iteration-do ((blocking boolean))
-    boolean nil nil)
-  (gtk-main ())
-  (gtk-main-quit ())
-  (gtk-main-level () int)
-  (gtk-get-current-event-time ()
-    uint32)
+  (gtk-init :void
+	    ((argc :pointer) (argv :pointer)))
+  (gtk-init-check :gtk-boolean
+		  ((argc :pointer)
+		   (argv :pointer)))
+  (gtk-events-pending :gtk-boolean ())
+  (gtk-main-iteration :gtk-boolean ())
+  (gtk-main-iteration-do :gtk-boolean
+			 ((blocking :gtk-boolean)))
+  (gtk-main :void ())
+  (gtk-main-quit :void ())
+  (gtk-main-level :int ())
+  (gtk-get-current-event-time :unsigned-int ())
 
   ;;container
-  (gtk-container-add ((container c-pointer)
-		      (widget  c-pointer))
-       c-pointer)
-  (gtk-container-remove ((container c-pointer)
-			 (widget c-pointer)))
+  (gtk-container-add :pointer
+		     ((container :pointer)
+		      (widget :pointer)))
+  (gtk-container-remove :void
+			((container :pointer)
+			 (widget :pointer)))
 
   ;;box
-  (gtk-box-pack-start ((box c-pointer)
-		       (widget c-pointer)
-		       (expand boolean)
-		       (fill boolean)
-		       (padding int))
-    nil nil nil)
-  (gtk-box-pack-start-defaults ((box c-pointer)
-				(widget c-pointer)))
-  (gtk-box-set-homogeneous ((box c-pointer)
-			     (homogeneous boolean))
-    nil nil nil)
-  (gtk-box-set-spacing ((box c-pointer)
-			(spacing int)))
-  (gtk-hbox-new ((homogeneous boolean)
-		 (spacing int))
-    c-pointer nil nil)
-  (gtk-vbox-new ((homogeneous boolean)
-		 (spacing int))
-    c-pointer nil nil)
-
-  (gtk-drawing-area-new ()
-   c-pointer)
+  (gtk-box-pack-start :void
+		      ((box :pointer)
+		       (widget :pointer)
+		       (expand :gtk-boolean)
+		       (fill :gtk-boolean)
+		       (padding :int)))
+  (gtk-box-pack-start-defaults :void
+			       ((box :pointer)
+				(widget
+				 :pointer)))
+  (gtk-box-set-homogeneous :void
+			   ((box :pointer)
+			    (homogeneous
+			     :gtk-boolean)))
+  (gtk-box-set-spacing :void
+		       ((box :pointer)
+			(spacing :int)))
+  (gtk-hbox-new :pointer
+		((homogeneous :gtk-boolean)
+		 (spacing :int)))
+  (gtk-vbox-new :pointer
+		((homogeneous :gtk-boolean)
+		 (spacing :int)))
+  (gtk-drawing-area-new :pointer ())
 
   ;;table
-  (gtk-table-new ((rows uint)
-		  (columns uint)
-		  (homogeneous boolean))
-    c-pointer nil nil)
-  (gtk-table-attach ((table c-pointer)
-		     (child c-pointer)
-		     (l-attach uint)
-		     (r-attach uint)
-		     (t-attach uint)
-		     (b-attach uint)
-		     (x-options int)
-		     (y-options int)
-		     (x-padding int)
-		     (y-padding int)))
-  (gtk-table-attach-defaults ((table c-pointer)
-			      (child c-pointer)
-			      (l-attach uint)
-			      (r-attach uint)
-			      (t-attach uint)
-			      (b-attach uint)))
-  (gtk-table-set-homogeneous ((table c-pointer)
-			     (homogeneous boolean))
-    nil nil nil)
+  (gtk-table-new :pointer
+		 ((rows :unsigned-int)
+		  (columns :unsigned-int)
+		  (homogeneous :gtk-boolean)))
+  (gtk-table-attach :void
+		    ((table :pointer)
+		     (child :pointer)
+		     (l-attach :unsigned-int)
+		     (r-attach :unsigned-int)
+		     (t-attach :unsigned-int)
+		     (b-attach :unsigned-int)
+		     (x-options :int)
+		     (y-options :int)
+		     (x-padding :int)
+		     (y-padding :int)))
+  (gtk-table-attach-defaults :void
+			     ((table :pointer)
+			      (child :pointer)
+			      (l-attach
+			       :unsigned-int)
+			      (r-attach
+			       :unsigned-int)
+			      (t-attach
+			       :unsigned-int)
+			      (b-attach
+			       :unsigned-int)))
+  (gtk-table-set-homogeneous :void
+			     ((table :pointer)
+			      (homogeneous
+			       :gtk-boolean)))
 
   ;;paned
-  (gtk-paned-add1 ((paned c-pointer)
-		   (child c-pointer)))
-  (gtk-paned-add2 ((paned c-pointer)
-		   (child c-pointer)))
-  (gtk-paned-set-position ((paned c-pointer)
-			   (pos int)))
-  (gtk-hpaned-new ()
-    c-pointer)
-  (gtk-vpaned-new ()
-    c-pointer)
+  (gtk-paned-add1 :void
+		  ((paned :pointer)
+		   (child :pointer)))
+  (gtk-paned-add2 :void
+		  ((paned :pointer)
+		   (child :pointer)))
+  (gtk-paned-set-position :void
+			  ((paned :pointer)
+			   (pos :int)))
+  (gtk-hpaned-new :pointer ())
+  (gtk-vpaned-new :pointer ())
 
   ;;expander
-  (gtk-expander-new ((label c-string))
-    c-pointer)
-  (gtk-expander-set-expanded ((expander c-pointer)
-			      (expanded boolean)))
-  (gtk-expander-set-spacing ((expander c-pointer)
-			     (spacing c-pointer)))
-  (gtk-expander-set-label ((expander c-pointer)
-			   (label c-string)))
-  (gtk-expander-set-use-underline ((expander c-pointer)
-				   (use-underline boolean)))
-  (gtk-expander-set-use-markup ((expander c-pointer)
-				(use-markup boolean)))
-  (gtk-expander-set-label-widget ((expander c-pointer)
-				  (label-widget c-pointer)))
-
-  ;;alignment 
-  (gtk-alignment-new ((xalign single-float)
-		      (yalign single-float)
-		      (xscale single-float)
-		      (yscale single-float))
-    c-pointer)
-  (gtk-alignment-set ((alignment c-pointer)
-		      (xalign single-float)
-		      (yalign single-float)
-		      (xscale single-float)
-		      (yscale single-float)))
-  
+  (gtk-expander-new :pointer
+		    ((label :gtk-string)))
+  (gtk-expander-set-expanded :void
+			     ((expander :pointer)
+			      (expanded
+			       :gtk-boolean)))
+  (gtk-expander-set-spacing :void
+			    ((expander :pointer)
+			     (spacing :pointer)))
+  (gtk-expander-set-label :void
+			  ((expander :pointer)
+			   (label :gtk-string)))
+  (gtk-expander-set-use-underline :void
+				  ((expander
+				    :pointer)
+				   (use-underline
+				    :gtk-boolean)))
+  (gtk-expander-set-use-markup :void
+			       ((expander
+				 :pointer)
+				(use-markup
+				 :gtk-boolean)))
+  (gtk-expander-set-label-widget :void
+				 ((expander
+				   :pointer)
+				  (label-widget
+				   :pointer)))
+
+  ;;alignment
+  (gtk-alignment-new :pointer
+		     ((xalign :float)
+		      (yalign :float)
+		      (xscale :float)
+		      (yscale :float)))
+  (gtk-alignment-set :void
+		     ((alignment :pointer)
+		      (xalign :float)
+		      (yalign :float)
+		      (xscale :float)
+		      (yscale :float)))
+
   ;;frame
-  (gtk-frame-new ((label c-string))
-    c-pointer)
-  (gtk-frame-set-label ((frame c-pointer)
-			(label c-string)))
-  (gtk-frame-set-label-widget ((frame c-pointer)
-			 (label-widget c-pointer)))
-  (gtk-frame-set-label-align ((frame c-pointer)
-			      (xalign single-float)
-			      (yalign single-float)))
-  (gtk-frame-set-shadow-type ((frame c-pointer)
-			      (shadow-type int)))
-  
+  (gtk-frame-new :pointer ((label :gtk-string)))
+  (gtk-frame-set-label :void
+		       ((frame :pointer)
+			(label :gtk-string)))
+  (gtk-frame-set-label-widget :void
+			      ((frame :pointer)
+			       (label-widget
+				:pointer)))
+  (gtk-frame-set-label-align :void
+			     ((frame :pointer)
+			      (xalign :float)
+			      (yalign :float)))
+  (gtk-frame-set-shadow-type :void
+			     ((frame :pointer)
+			      (shadow-type :int)))
+
   ;;aspect-frame
-  (gtk-aspect-frame-new ((label c-string)
-			 (xalign single-float)
-			 (yalign single-float)
-			 (ratio single-float)
-			 (obey_child boolean))
-    c-pointer)
-
-  ;;separator
-  (gtk-hseparator-new ()
-    c-pointer)
-  (gtk-vseparator-new ()
-    c-pointer)
-
-  ;;scrolling
-  (gtk-scrolled-window-new ((hadjustment c-pointer)
-			    (vadjustment c-pointer))
-    c-pointer)
-  (gtk-scrolled-window-set-policy ((scrolled-window c-pointer)
-				   (h-policy int)
-				   (v-policy int)))
-  (gtk-scrolled-window-add-with-viewport ((scrolled-window c-pointer)
-					  (child c-pointer)))
-  (gtk-scrolled-window-set-placement ((scrolled-window c-pointer)
-				      (placement int)))
-  (gtk-scrolled-window-set-shadow-type ((scrolled-window c-pointer)
-					(type int)))
-
-  ;;notebook 
-  (gtk-notebook-new ()
-    c-pointer)
-  (gtk-notebook-append-page ((notebook c-pointer)
-			     (child c-pointer)
-			     (tab-label c-pointer))
-    int)
-  (gtk-notebook-append-page-menu ((notebook c-pointer)
-				  (child c-pointer)
-				  (tab-label c-pointer)
-				  (menu-label c-pointer))
-    int)
-  (gtk-notebook-prepend-page ((notebook c-pointer)
-			     (child c-pointer)
-			     (tab-label c-pointer))
-    int)
-  (gtk-notebook-prepend-page-menu ((notebook c-pointer)
-				  (child c-pointer)
-				  (tab-label c-pointer)
-				  (menu-label c-pointer))
-    int)
-  (gtk-notebook-insert-page ((notebook c-pointer)
-			     (child c-pointer)
-			     (tab-label c-pointer)
-			     (pos int))
-    int)
-  (gtk-notebook-insert-page-menu ((notebook c-pointer)
-				  (child c-pointer)
-				  (tab-label c-pointer)
-				  (menu-label c-pointer)
-				  (pos int))
-    int)
-  (gtk-notebook-remove-page ((notebook c-pointer)
-			     (page-num int)))
-  (gtk-notebook-set-current-page ((notebook c-pointer)
-				  (page-num int)))
-  (gtk-notebook-set-tab-pos ((notebook c-pointer)
-			     (pos int)))
-  (gtk-notebook-set-show-tabs ((notebook c-pointer)
-			       (show-tabs boolean)))
-  (gtk-notebook-set-show-border ((notebook c-pointer)
-				 (show-border boolean)))
-  (gtk-notebook-set-scrollable ((notebook c-pointer)
-			       (scrollable boolean)))
-  (gtk-notebook-set-tab-border ((notebook c-pointer)
-				(border-width int)))
-  (gtk-notebook-popup-enable ((notebook c-pointer)))
-  (gtk-notebook-popup-disable ((notebook c-pointer)))
-  (gtk-notebook-set-homogeneous-tabs ((notebook c-pointer)
-				      (homogeneous-tabs boolean)))
-  (gtk-notebook-get-nth-page ((notebook c-pointer)
-			      (n int))
-    c-pointer)
-  (gtk-notebook-get-n-pages ((notebook c-pointer))
-   int)
+  (gtk-aspect-frame-new :pointer
+			((label :gtk-string)
+			 (xalign :float)
+			 (yalign :float)
+			 (ratio :float)
+			 (obey_child
+			  :gtk-boolean)))
+  ;; separator
+  (gtk-hseparator-new :pointer ())
+  (gtk-vseparator-new :pointer ())
+
+  ;;scrolled
+  (gtk-scrolled-window-new :pointer
+			   ((hadjustment :pointer)
+			    (vadjustment
+			     :pointer)))
+  (gtk-scrolled-window-set-policy :void
+				  ((scrolled-window
+				    :pointer)
+				   (h-policy :int)
+				   (v-policy :int)))
+  (gtk-scrolled-window-add-with-viewport :void
+					 ((scrolled-window :pointer)
+					  (child :pointer)))
+  (gtk-scrolled-window-set-placement :void
+				     ((scrolled-window :pointer)
+				      (placement :int)))
+  (gtk-scrolled-window-set-shadow-type :void
+				       ((scrolled-window :pointer)
+					(type :int)))
+
+  ;;notebook
+  (gtk-notebook-new :pointer ())
+  (gtk-notebook-append-page :int
+			    ((notebook :pointer)
+			     (child :pointer)
+			     (tab-label :pointer)))
+  (gtk-notebook-append-page-menu :int
+				 ((notebook :pointer)
+				  (child :pointer)
+				  (tab-label :pointer)

[1161 lines skipped]



From pdenno at common-lisp.net  Thu Feb 16 18:06:46 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:06:46 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180646.7BFE24D015@common-lisp.net>

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

Modified Files:
	gtk-tool.lisp 
Log Message:
Now native CFFI

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-tool.lisp	2004/12/06 20:03:00	1.1
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-tool.lisp	2006/02/16 18:06:46	1.2
@@ -18,67 +18,92 @@
 
 (in-package :gtk-ffi)
 
-
 (def-gtk-lib-functions :gtk
   ;;toolbar
-  (gtk-toolbar-new ()
-    c-pointer)
-  (gtk-toolbar-insert ((toolbar c-pointer)
-		       (item c-pointer)
-		       (pos int)))
-  (gtk-toolbar-set-show-arrow ((toolbar c-pointer)
-			       (show-arrow boolean)))
-  (gtk-toolbar-set-orientation ((toolbar c-pointer)
-				(orientation int)))
-  (gtk-toolbar-set-tooltips ((toolbar c-pointer)
-			     (enable boolean)))
-  (gtk-toolbar-set-style ((toolbar c-pointer)
-			  (style int)))
+  (gtk-toolbar-new :pointer ())
+  (gtk-toolbar-insert
+   :void
+   ((toolbar :pointer)
+    (item :pointer)
+    (pos :int)))
+  (gtk-toolbar-set-show-arrow
+   :void
+   ((toolbar :pointer)
+    (show-arrow :gtk-boolean)))
+  (gtk-toolbar-set-orientation
+   :void
+   ((toolbar :pointer) (orientation :int)))
+  (gtk-toolbar-set-tooltips
+   :void
+   ((toolbar :pointer) (enable :gtk-boolean)))
+  (gtk-toolbar-set-style
+   :void
+   ((toolbar :pointer) (style :int)))
 
   ;;tooltips
-  (gtk-tooltips-new ()
-    c-pointer)
-  (gtk-tooltips-set-tip ((tooltips c-pointer)
-			 (widget c-pointer)
-			 (tip-text c-string)
-			 (tip-private c-string)))
-  (gtk-tooltips-enable ((tooltips c-pointer)))
-  (gtk-tooltips-disable ((tooltips c-pointer)))
-  (gtk-tooltips-set-delay ((tooltips c-pointer)
-			   (delay uint)))
-  ;;tool-item
-  (gtk-tool-item-new ()
-    c-pointer)
-  (gtk-tool-item-set-homogeneous ((tool-item c-pointer)
-				  (homogeneous boolean)))
-  (gtk-tool-item-set-expand ((tool-item c-pointer)
-			     (expand boolean)))
-  (gtk-tool-item-set-tooltip ((tool-item c-pointer)
-			      (tooltips c-pointer)
-			      (tip-text c-string)
-			      (tip-private c-string)))
-  (gtk-tool-item-set-is-important ((tool-item c-pointer)
-				   (is-important boolean)))
+  (gtk-tooltips-new :pointer ())
+  (gtk-tooltips-set-tip
+   :void
+   ((tooltips :pointer)
+    (widget :pointer)
+    (tip-text :gtk-string)
+    (tip-private :gtk-string)))
+  (gtk-tooltips-enable
+   :void
+   ((tooltips :pointer)))
+  (gtk-tooltips-disable
+   :void
+   ((tooltips :pointer)))
+  (gtk-tooltips-set-delay
+   :void
+   ((tooltips :pointer) (delay :unsigned-int)))
 
-  (gtk-separator-tool-item-new ()
-     c-pointer)
-  (gtk-separator-tool-item-set-draw ((item c-pointer)
-				     (draw boolean)))
+  ;;tool-item
+  (gtk-tool-item-new :pointer ())
+  (gtk-tool-item-set-homogeneous
+   :void
+   ((tool-item :pointer)
+    (homogeneous :gtk-boolean)))
+  (gtk-tool-item-set-expand
+   :void
+   ((tool-item :pointer) (expand :gtk-boolean)))
+  (gtk-tool-item-set-tooltip
+   :void
+   ((tool-item :pointer)
+    (tooltips :pointer)
+    (tip-text :gtk-string)
+    (tip-private :gtk-string)))
+  (gtk-tool-item-set-is-important
+   :void
+   ((tool-item :pointer)
+    (is-important :gtk-boolean)))
+  (gtk-separator-tool-item-new :pointer ())
+  (gtk-separator-tool-item-set-draw
+   :void
+   ((item :pointer) (draw :gtk-boolean)))
 
   ;;tool-button
-  (gtk-tool-button-new ((icon-widget c-pointer)
-			(label c-pointer))
-    c-pointer)
-  (gtk-tool-button-new-from-stock ((stock-id c-string))
-    c-pointer)
-  (gtk-tool-button-set-label ((tool-button c-pointer)
-			      (label c-pointer)))
-  (gtk-tool-button-set-use-underline ((tool-button c-pointer)
-				      (use-underline boolean)))
-  (gtk-tool-button-set-stock-id ((tool-button c-pointer)
-				 (stock-id c-string)))
-  (gtk-tool-button-set-icon-widget ((tool-button c-pointer)
-				    (icon-widget c-pointer)))
-  (gtk-tool-button-set-label-widget ((tool-button c-pointer)
-				     (label-widget c-pointer))))
-  
+  (gtk-tool-button-new
+   :pointer
+   ((icon-widget :pointer) (label :pointer)))
+  (gtk-tool-button-new-from-stock
+   :pointer
+   ((stock-id :gtk-string)))
+  (gtk-tool-button-set-label
+   :void
+   ((tool-button :pointer) (label :pointer)))
+  (gtk-tool-button-set-use-underline
+   :void
+   ((tool-button :pointer)
+    (use-underline :gtk-boolean)))
+  (gtk-tool-button-set-stock-id
+   :void
+   ((tool-button :pointer) (stock-id :gtk-string)))
+  (gtk-tool-button-set-icon-widget
+   :void
+   ((tool-button :pointer)
+    (icon-widget :pointer)))
+  (gtk-tool-button-set-label-widget
+   :void
+   ((tool-button :pointer)
+    (label-widget :pointer))))
\ No newline at end of file



From pdenno at common-lisp.net  Thu Feb 16 18:07:50 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:07:50 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180750.193694D015@common-lisp.net>

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

Modified Files:
	gtk-utilities.lisp 
Log Message:
A few nils should have been +c-null+, use cffi:foreign-alloc

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/11 03:48:09	1.17
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/16 18:07:50	1.18
@@ -26,13 +26,13 @@
 
 (defun g-signal-connect-data (self detailed-signal c-handler data destroy-data after)
   (uffi:with-cstrings ((c-detailed-signal detailed-signal))
-    (let ((p4 (or data c-null)))
+    (let ((p4 (or data +c-null+)))
       (g_signal_connect_data
        self
        c-detailed-signal
        (wrap-func c-handler)
        p4
-       (or destroy-data c-null)
+       (or destroy-data +c-null+)
        (if after 1 0)))))
 
 (uffi:def-function ("g_signal_connect_data" g_signal_connect_data)
@@ -44,7 +44,7 @@
   (or func-address 0))
 
 
-(defun gtk-signal-connect-swap (widget signal fun &key (after t) data destroy-data)
+(defun gtk-signal-connect-swap (widget signal fun &key (after t) data (destroy-data +c-null+)) ; pod 0216
   (g-signal-connect-closure widget signal
     (g-cclosure-new-swap (wrap-func fun) data destroy-data) after))
 
@@ -68,12 +68,12 @@
                    :null-terminated-p t)
      #-(or allegro lispworks)
      (with-foreign-object (bytes-written :int)
-       (g-locale-from-utf8 pointer -1 nil bytes-written nil)))))
+       (g-locale-from-utf8 pointer -1 +c-null+ bytes-written +c-null+)))))
 
 (defun to-gtk-string (str)
   "!!!! remember to free returned str pointer"
   (with-foreign-object (bytes-written :int)
-    (g-locale-to-utf8 str -1 c-null bytes-written c-null)))
+    (g-locale-to-utf8 str -1 +c-null+ bytes-written +c-null+)))
 
 (defmacro with-gdk-threads (&rest body)
   `(unwind-protect
@@ -101,7 +101,7 @@
                            :data menu))
 
 (defun gtk-list-store-new (col-types)
-  (let ((c-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))))
+  (let ((c-types (cffi:foreign-alloc :int :count (length col-types))))
     (loop for type in col-types
           for n upfrom 0
           do (setf (cffi:mem-aref c-types :int n) (coerce (as-gtk-type type) 'integer)))
@@ -146,7 +146,7 @@
       (gvi :post-set))))
 
 (defun gtk-tree-store-new (col-types)
-  (let ((gtk-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))
+  (let ((gtk-types (cffi:foreign-alloc :int :count (length col-types))))
     (loop for type in col-types
           for tn upfrom 0
           do (setf (cffi:mem-aref gtk-types :int tn) (coerce (as-gtk-type type) 'integer)))



From pdenno at common-lisp.net  Thu Feb 16 18:08:15 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:08:15 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216180815.68D9C4D015@common-lisp.net>

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

Removed Files:
	gtk-definitions.lisp 
Log Message:
Not used




From pdenno at common-lisp.net  Thu Feb 16 18:09:31 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:09:31 -0600 (CST)
Subject: [cells-gtk-cvs] CVS 
Message-ID: <20060216180931.62D1C4D015@common-lisp.net>

Update of /project/cells-gtk/cvsroot
In directory common-lisp:/tmp/cvs-serv9159

Modified Files:
	INSTALL.TXT 
Log Message:
New procedure *gtk-lib-path* is gone! Note testing of SBCL and new windows GTK+ lib

--- /project/cells-gtk/cvsroot/INSTALL.TXT	2006/01/03 19:13:50	1.1
+++ /project/cells-gtk/cvsroot/INSTALL.TXT	2006/02/16 18:09:31	1.2
@@ -7,16 +7,13 @@
 
 STEP 1: EVERYONE: Start lisp, change to this directory and do (load "load")
 
-STEP 2: EVERYONE: If STEP 1 didn't go well, look at the settings of 
-        *gtk-lib-path* in file ./root/gtk-ffi/gtk-ffi.asd
+STEP 2: EVERYONE: (test-gtk::gtk-demo)
 
-STEP 3: EVERYONE: (test-gtk::gtk-demo)
-
-STEP 4: ANYONE (optional) make libcellsgtk, (or get it from the cells-gtk site). To make:
-         4a) In ./root/gtk-ffi 'make' 
-         4b) Move the library created to whatever *gtk-lib-path* is set to.
-         4c) Uncomment the line (pushnew :libcellsgtk *features*) in ./root/gtk-ffi/gtk-ffi.asd
-         4d) Recompile the distribution (remove fasls and type (load "load") again.
+STEP 3: ANYONE (optional) make libcellsgtk, (or get it from the cells-gtk site). To make:
+         3a) In ./root/gtk-ffi 'make' 
+         3b) Move the library created to where it will be found (Linux see /etc/ld.so.conf).
+         3c) Uncomment the line (pushnew :libcellsgtk *features*) in ./root/gtk-ffi/gtk-ffi.asd
+         3d) Recompile the distribution (remove fasls and type (load "load") again.
 
 
 TESTED ON:
@@ -28,18 +25,17 @@
      Lispworks 4.4 Pro, 
      CMUCL 19c, 
      CLISP 2.36
+     SBCL 0.9.9.1
 
 NOT TESTED SINCE SWITCHING TO CFFI: (as of 2006-01-03):
     AllegroCL
-    MACOS
-    SBCL - never tested, but probably pretty close to OK. 
+    MACOSX
 
 ;;; --------   Windows Users ---------------
 
-
 Get GTK and Install
 
-   http://gimp-win.sourceforge.net/stable.html
+   http://gimp-win.sourceforge.net/stable.html  (I used version 2.8.9)
    
    Executing the setup.exe should add "C:\Program Files\Common Files\GTK\2.0\bin"
    to your path. You can verify that it has:
@@ -50,6 +46,8 @@
 
 Note: On windows under emacs with slime, the gtk window does not popup. 
       You must start the application from a dos prompt. 
+      (Solutions to this problem welcome!, probably involves putting something
+       like a call to gtk-iteration-do into some slime loop through a hook.)
 
 Known bugs:
     On Windows: Clisp crashes if    



From pdenno at common-lisp.net  Thu Feb 16 18:10:10 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:10:10 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181010.ED92E4E012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9254/root/cells-gtk

Modified Files:
	buttons.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/buttons.lisp	2004/12/22 16:23:50	1.5
+++ /project/cells-gtk/cvsroot/root/cells-gtk/buttons.lisp	2006/02/16 18:10:10	1.6
@@ -85,7 +85,7 @@
   :new-args (c? (and (upper self box)
 		     (list
 		      (if (eql (first (kids (fm-parent self))) self) 
-			  c-null
+			  +c-null+
 			  (id (first (kids (fm-parent self))))))))
   :on-toggled  (callback (widget event data)
                  ;;(print (list :radio-button widget event data))



From pdenno at common-lisp.net  Thu Feb 16 18:11:08 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:11:08 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181108.70A774E012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9273/root/cells-gtk

Modified Files:
	cells-gtk.asd 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd	2006/01/03 18:55:16	1.6
+++ /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd	2006/02/16 18:11:08	1.7
@@ -11,7 +11,7 @@
    (:file "widgets" :depends-on ("conditions"))
    (:file "layout" :depends-on ("widgets"))
    (:file "display" :depends-on ("widgets"))
-#+notyet(:file "drawing" :depends-on ("widgets")) ; not ready yet.
+;   (:file "drawing" :depends-on ("widgets"))
    (:file "buttons" :depends-on ("widgets"))
    (:file "entry" :depends-on ("widgets"))
    (:file "tree-view" :depends-on ("widgets"))



From pdenno at common-lisp.net  Thu Feb 16 18:12:15 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:12:15 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181215.BA7A14E012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9292/root/cells-gtk

Modified Files:
	conditions.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/conditions.lisp	2005/02/26 22:22:05	1.2
+++ /project/cells-gtk/cvsroot/root/cells-gtk/conditions.lisp	2006/02/16 18:12:15	1.3
@@ -21,18 +21,18 @@
 (defmacro gtk-report-error (type string &body args)
   `(error ',type :format-string ,string :format-arguments (list , at args)))
 
-(define-condition gtk-continuable-error (condition) ())
+(define-condition gtk-continuable-error (condition)
+  ((text :initarg :text :reader text)))
 
 (define-condition gtk-cells-error (gtk-continuable-error) 
-  ((format-string :initarg :format-string)
-   (format-arguments :initarg :format-arguments))
-  (:report (lambda (err stream)
-	     (with-slots (format-string format-arguments) err
-	       (apply #'format stream format-string format-arguments)))))
+  ((format-string :initarg :format-string :reader format-string)
+   (format-arguments :initarg :format-arguments :reader format-arguments))
+  (:report (lambda (c stream)
+	     (apply #'format stream (format-string c) (format-arguments c)))))
 
-(define-condition gtk-object-id-error (gtk-cells-error)
-  ())
+(define-condition gtk-object-id-error (gtk-cells-error) ())
 
-(define-condition gtk-user-signals-quit (condition)
-  ())
+(define-condition gtk-user-signals-quit (condition) ())
+
+(export '(gtk-user-signals-quit gtk-continuable-error gtk-report-error))
 



From pdenno at common-lisp.net  Thu Feb 16 18:12:54 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:12:54 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181254.59B514E012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9313/root/cells-gtk

Modified Files:
	dialogs.lisp 
Log Message:
nil --> +c-null+

--- /project/cells-gtk/cvsroot/root/cells-gtk/dialogs.lisp	2005/02/26 22:24:27	1.5
+++ /project/cells-gtk/cvsroot/root/cells-gtk/dialogs.lisp	2006/02/16 18:12:54	1.6
@@ -29,7 +29,7 @@
   (markup)
   ()
   :position :mouse
-  :new-args (c? (list c-null
+  :new-args (c? (list +c-null+
 		      2
 		      (ecase (message-type self)
 			(:info 0)
@@ -125,7 +125,7 @@
   ()
   :on-selection-changed nil
   :position :mouse
-  :new-args (c? (list (title self) c-null (action-id self)
+  :new-args (c? (list (title self) +c-null+ (action-id self)
 		      "gtk-cancel" -6 ;;response-cancel
 		      (format nil "gtk-~a"
 			      (string-downcase 
@@ -136,7 +136,7 @@
 					:apply
 					(action self))))))
 		      -5  ;;response-ok
-		      nil)))
+		      +c-null+)))
 
 (defmethod md-awaken :after ((self file-chooser-dialog))
   (let ((response (gtk-dialog-run (id self))))



From pdenno at common-lisp.net  Thu Feb 16 18:13:57 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:13:57 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181357.E11894E012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9347/root/cells-gtk

Modified Files:
	drawing.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/02/11 03:34:09	1.4
+++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/02/16 18:13:57	1.5
@@ -1,7 +1,6 @@
 #|
 
- Cells Gtk Copyright (c) 2004 by Vasilis Margioulas <vasilism at sch.gr>
- This file  Copyright (c) 2005 by Peter Denno <peter.denno at nist.gov>
+ Copyright (c) 2005 by Peter Denno <peter.denno at nist.gov>
 
  You have the right to distribute and use this software as governed by 
  the terms of the Lisp Lesser GNU Public License (LLGPL):



From pdenno at common-lisp.net  Thu Feb 16 18:15:14 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:15:14 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181514.B08304F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv9994/root/cells-gtk

Modified Files:
	gtk-app.lisp 
Log Message:
Uses restarts instead of kludgy code.

--- /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp	2006/01/03 18:57:41	1.15
+++ /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp	2006/02/16 18:15:14	1.16
@@ -25,11 +25,10 @@
    (tooltips-delay :accessor tooltips-delay :initarg :tooltips-delay :initform (c-in nil))
    (stock-icons :cell nil :accessor stock-icons :initarg :stock-icons :initform nil))
   (:default-initargs
-      :on-delete-event (lambda (self widget event data)
-                         (declare (ignore self widget event data))
-                         #+lispworks(signal 'gtk-user-signals-quit)
-                         #-lispworks(gtk-main-quit)
-                         0)))
+   :on-delete-event (lambda (self widget event data)
+		      (declare (ignore self widget event data))
+		      (signal 'gtk-user-signals-quit)
+		      0)))
 
 
 (defmethod initialize-instance :after ((self gtk-app) &key stock-icons)
@@ -62,16 +61,16 @@
 
 (defvar *gtk-initialized* nil)
 
+
 (defun start-app (app-name &key debug)
   (let ((*gtk-debug* debug))
     (when (not *gtk-initialized*)
       (when *gtk-debug*
         (trc nil "GTK INITIALIZATION") (force-output))
-      (g-thread-init c-null)
+      (g-thread-init +c-null+)
       (gdk-threads-init)
-      (assert (gtk-init-check c-null-int c-null))
+      (assert (gtk-init-check +c-null+ +c-null+))
       (setf *gtk-initialized* t))
-    (setf (gtk-user-quit-p) nil)
     
     (with-gdk-threads
         (let ((app (make-instance app-name :visible (c-in nil)))
@@ -84,38 +83,49 @@
             (setf (visible splash) t)
             (loop while (gtk-events-pending) do
                  (gtk-main-iteration)))
-          
+
           (to-be app)
-          
+
           (when splash
             (not-to-be splash)
             (gtk-window-set-auto-startup-notification t))
           (setf (visible app) t)
-          (when *gtk-debug*
-            (trc nil "STARTING GTK-MAIN") (force-output))
-          #-lispworks 
-          (gtk-main)
-          #+lispworks
-          (flet ((do-gtk () (loop while (gtk-events-pending) do 
-				  (gtk-main-iteration-do nil))))
-              (unwind-protect
-                (catch 'try-again
-                  (handler-case
-                    (loop
-                       (do-gtk)
-                       (when (gtk-user-quit-p) (signal 'gtk-user-signals-quit))
-                       (process-wait-with-timeout .01 "GTK event loop waiting"))
-                    (gtk-continuable-error (err)
-                      (show-message (format nil "Cells-GTK Error: ~a" err) 
-                                    :message-type :error :title "Cells-GTK Error")
-                      (throw 'try-again nil)) ; This doesn't really work. u-p cleanup forms invoked.
-                    (gtk-user-signals-quit ()
-		      (loop while (> (gtk-main-level) 0) do (gtk-main-quit))
-                      (return-from start-app))))
-                (not-to-be app)
-		(loop while (> (gtk-main-level) 0) do (gtk-main-quit))
-                (do-gtk)))))))
-
+          (when *gtk-debug* (trc nil "STARTING GTK-MAIN") (force-output))
+	  (unwind-protect
+	     (loop 
+	      (restart-case
+	       (handler-bind 
+		((gtk-user-signals-quit #'give-up-cleanly)
+		 (gtk-continuable-error #'continue-from-error)
+		 (error #'report-error-and-give-up))
+		#-lispworks
+		(gtk-main)
+		#+lispworks ; give slime a chance.
+		(loop ; just running your app in a process is not enough.
+		 (loop while (gtk-events-pending) do 
+		       (gtk-main-iteration-do nil))
+		 (process-wait-with-timeout .01 "GTK event loop waiting")))
+	       ;; Restart cases
+	       (continue-from-error (c)
+		  (show-message (format nil "Cells-GTK Error: ~a" (text c))
+				:message-type :error :title "Cells-GTK Error"))
+	       (give-up-cleanly () (return-from start-app))
+	       (report-error-and-give-up (c) (error c))))
+	    ;; clean-up forms (takes down application).
+	    (not-to-be app) ; while (> (gtk-main-level) 0) do (gtk-main-quit) NG. Why?
+	    (loop for i from 0 to 99 do (gtk-main-quit))
+	    (loop while (gtk-events-pending) do (gtk-main-iteration-do nil)))))))
+
+;;; Restarts
+(defun continue-from-error (c)
+  (invoke-restart 'continue-from-error c))
+
+(defun report-error-and-give-up (c)
+  (invoke-restart 'report-error-and-give-up c))
+
+(defun give-up-cleanly (c)
+  (declare (ignore c))
+  (invoke-restart 'give-up-cleanly))
 
 (defvar *gtk-global-callbacks* nil)
 (defvar *gtk-loaded* #+clisp t #-clisp nil) ;; kt: looks like CLisp does this on its own
@@ -127,8 +137,7 @@
     (make-array 128 :adjustable t :fill-pointer 0)))
 
 (defun gtk-global-callback-register (callback)
-  (vector-push-extend callback
-    *gtk-global-callbacks* 16))
+  (vector-push-extend callback *gtk-global-callbacks* 16))
 
 (defun gtk-global-callback-funcall (n)
   (trc nil "gtk-global-callback-funcall >" n
@@ -143,13 +152,7 @@
     (setf *gtk-loaded* t))
   (gtk-reset))
 
-;;; Implements quits other than through destroy.
-(let (quit)
-  (defun gtk-user-quit-p () quit)
-  (defun (setf gtk-user-quit-p) (val) 
-    (setf quit val))
-)
-
 (eval-when (compile load eval)
   (export '(gtk-app gtk-reset cells-gtk-init title icon tooltips tooltips-enable tooltips-delay
-             start-app gtk-global-callback-register gtk-global-callback-funcall gtk-user-quit-p)))
\ No newline at end of file
+             start-app gtk-global-callback-register gtk-global-callback-funcall)))
+



From pdenno at common-lisp.net  Thu Feb 16 18:15:48 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:15:48 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181548.119CB4F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10692/root/cells-gtk

Modified Files:
	layout.lisp 
Log Message:
nil --> +c-null+

--- /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp	2006/01/03 18:58:54	1.6
+++ /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp	2006/02/16 18:15:47	1.7
@@ -185,7 +185,7 @@
   ()
   :expand t :fill t
   :policy (list 1 1)
-  :new-args (list c-null c-null))
+  :new-args (list +c-null+ +c-null+))
 
 (def-c-output .kids ((self scrolled-window))
   (assert-bin self)



From pdenno at common-lisp.net  Thu Feb 16 18:16:28 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:16:28 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181628.6DEDE4F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10718/root/cells-gtk

Modified Files:
	menus.lisp 
Log Message:
nil --> +c-null+

--- /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp	2005/10/08 14:28:49	1.11
+++ /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp	2006/02/16 18:16:28	1.12
@@ -74,7 +74,7 @@
 	   (pfunc #'(lambda (x) (list (funcall user-print-fn x)))))
       (loop for root in new-value
 	    for index from 0 do
-	    (gtk-tree-store-set-kids (id (tree-model self)) root c-null index
+	    (gtk-tree-store-set-kids (id (tree-model self)) root +c-null+ index
 				     '(:string :string) pfunc (children-fn self)))
       ;; Spec says iter must correspond to a path of depth one. But then there would be no point 
       ;; in set-active-iter.  Well, the spec seems to be wrong (or poorly worded).
@@ -162,7 +162,7 @@
    (label-widget :accessor label-widget :initarg :label-widget :initform (c-in nil)))
   (use-underline stock-id)
   (clicked)
-  :new-args (list c-null c-null))
+  :new-args (list +c-null+ +c-null+))
 
 (def-c-output icon-widget ((self tool-button))
   (when old-value
@@ -276,7 +276,7 @@
 		      (not-first-p (not (eql (first (kids (fm-parent self))) self))))		  
 		      (if (and in-group-p not-first-p)
 			  (list (id (first (kids (fm-parent self)))))			  
-			  (list c-null)))))
+			  (list +c-null+)))))
   
 (def-c-output .md-value ((self radio-menu-item))
   (when (and new-value (upper self menu-item))
@@ -291,7 +291,8 @@
   :new-tail (c? (when (stock self)
 		  '-from-stock))
   :new-args (c? (when (stock self)
-		  (list (string-downcase (format nil "gtk-~a" (stock self))) nil))))
+		  (list (string-downcase (format nil "gtk-~a" (stock self))) +c-null+))))
+
 
 (def-c-output image ((self image-menu-item))
   (when old-value



From pdenno at common-lisp.net  Thu Feb 16 18:16:55 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:16:55 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181655.227264F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10737/root/cells-gtk

Modified Files:
	packages.lisp 
Log Message:
use package POD

--- /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/02/11 03:35:13	1.3
+++ /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/02/16 18:16:55	1.4
@@ -18,7 +18,7 @@
 
 (defpackage :cells-gtk
   (:nicknames :cgtk)
-  (:use :common-lisp :utils-kt :cells :gtk-ffi :uffi ))
+  (:use :common-lisp :utils-kt :pod :cells :gtk-ffi :uffi ))
 
 
 



From pdenno at common-lisp.net  Thu Feb 16 18:17:22 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:17:22 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181722.C0D6C4F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10758/root/cells-gtk

Modified Files:
	textview.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/02/11 03:37:13	1.7
+++ /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/02/16 18:17:22	1.8
@@ -24,7 +24,7 @@
    (markup :cell nil :accessor markup :initform nil))
   ()
   (modified-changed)
-  :new-args (c? (list c-null)))
+  :new-args (c? (list +c-null+)))
 
 (def-c-output text ((self text-buffer))
   (let ((buf (id self)))



From pdenno at common-lisp.net  Thu Feb 16 18:18:02 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:18:02 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181802.600724F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10784/root/cells-gtk

Modified Files:
	tree-view.lisp 
Log Message:
nil --> +c-null+

--- /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/02/11 03:38:02	1.13
+++ /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/02/16 18:18:02	1.14
@@ -96,7 +96,7 @@
   (let ((selection (gtk-tree-view-get-selection (id self)))
         (cb (cffi:get-callback 'tree-view-items-selector)))
     (setf (selected-items-cache self) nil)
-    (gtk-tree-selection-selected-foreach selection cb c-null)
+    (gtk-tree-selection-selected-foreach selection cb +c-null+)
     (if (equal (gtk-tree-selection-get-mode selection) 3) ;;multiple
       (copy-list (selected-items-cache self))
     (first (selected-items-cache self)))))
@@ -187,7 +187,7 @@
   (when new-value
     (loop for root in new-value
        for index from 0 do
-	 (gtk-tree-store-set-kids (id (tree-model self)) root c-null index
+	 (gtk-tree-store-set-kids (id (tree-model self)) root +c-null+ index
 				  (append (column-types self) (list :string)) 
 				  (print-fn self) (children-fn self)))
     (when (expand-all self)
@@ -235,7 +235,7 @@
                   (nth pos (column-types self))
                   (getf (column-render self) pos)))
               cb)
-            nil nil)
+            +c-null+ +c-null+)
           (gtk-tree-view-column-set-sort-column-id (id col) pos)
           (gtk-tree-view-insert-column (id self) (id col) pos))))
 



From pdenno at common-lisp.net  Thu Feb 16 18:18:56 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:18:56 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216181856.AA1984F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv10807/root/cells-gtk

Modified Files:
	widgets.lisp 
Log Message:
Cleanup timeout-add for CFFI

--- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/02/11 03:39:10	1.16
+++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/02/16 18:18:56	1.17
@@ -233,15 +233,16 @@
     (if r2 1 0)))
 
 (defun timeout-add (milliseconds function)
-  (let ((id (gtk-global-callback-register
+  "Call FUNCTION repeatedly, waiting MILLISECONDS between calls. 
+   Stops calling when function return false."
+  (let* ((id (gtk-global-callback-register
               (lambda ()
                 ;;(print :timeout-add-global)
                 (let ((r (with-gdk-threads
-                             (funcall function))))
+			  (funcall function))))
                   (trc nil "timeout func returning" r)
                   r))))
-        (c-id (fgn-alloc :int 1)))
-    (setf (cffi:mem-aref c-id :int 0) (coerce id 'integer))
+	 (c-id (cffi:foreign-alloc :int :initial-element id)))
     (trc nil "timeout-add > passing cb data, *data" c-id (cffi:mem-aref c-id :int 0))
     (g-timeout-add milliseconds (cffi:get-callback 'timeout-handler-callback) c-id)))
 
@@ -344,7 +345,7 @@
 
 (def-c-output icon ((self window))
   (when new-value
-    (gtk-window-set-icon-from-file (id self) new-value c-null)))
+    (gtk-window-set-icon-from-file (id self) new-value +c-null+)))
 
 (def-c-output decorated ((self window))
   (gtk-window-set-decorated (id self) new-value))



From pdenno at common-lisp.net  Thu Feb 16 18:19:41 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:19:41 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk/test-gtk
Message-ID: <20060216181941.56CCE4F014@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp:/tmp/cvs-serv10826/root/cells-gtk/test-gtk

Modified Files:
	test-buttons.lisp 
Log Message:
Test continueable errors

--- /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-buttons.lisp	2004/12/06 20:04:17	1.3
+++ /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-buttons.lisp	2006/02/16 18:19:41	1.4
@@ -24,6 +24,9 @@
 				:tooltip "Click ....."
 				:on-clicked (callback (widget event data)
 						      (incf (nclics (upper self test-buttons)))))
+		     (mk-button :label "Continuable error"
+				:on-clicked (callback (widget event data)
+						      (error 'gtk-continuable-error :text "Oops!")))
 		     (mk-toggle-button :md-name :toggled-button
 				       :markup (c? (with-markup (:foreground (if (md-value self) :red :blue))
 						     "_Toggled Button")))



From pdenno at common-lisp.net  Thu Feb 16 18:20:19 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:20:19 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk/test-gtk
Message-ID: <20060216182019.E5F0C50012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp:/tmp/cvs-serv10926/root/cells-gtk/test-gtk

Modified Files:
	test-display.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-display.lisp	2005/02/27 03:21:20	1.6
+++ /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-display.lisp	2006/02/16 18:20:19	1.7
@@ -2,8 +2,8 @@
 
 
 (defmodel test-display (vbox)
-  ()
-  (:default-initargs
+  ()                 
+  (:default-initargs ;; g_timeout_add a function that will move the bar until the "Pulse" toggle is false.
       :md-value (c? (when (md-value (fm-other :pulse))
                       (timeout-add (md-value (fm-other :timeout))
                         (lambda ()
@@ -40,10 +40,9 @@
             :kids (list
                    (mk-progress-bar :md-name :pbar2				      
                      :pulse-step (c? (md-value (fm^ :step)))
-                     :fraction (c-in 0))
-                   (mk-toggle-button :md-name :pulse
-                     :label "Pulse")
-                   (mk-label :text "Timeout")
+                     :fraction (c-in .1))
+                   (mk-toggle-button :md-name :pulse :label "Pulse")
+                   (mk-label :text "Interval")
                    (mk-spin-button :md-name :timeout
                      :sensitive (c? (not (md-value (fm^ :pulse))))
                      :min 10 :max 1000



From pdenno at common-lisp.net  Thu Feb 16 18:20:53 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:20:53 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk/test-gtk
Message-ID: <20060216182053.5748D50012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp:/tmp/cvs-serv10947/root/cells-gtk/test-gtk

Modified Files:
	test-gtk.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-gtk.lisp	2005/02/27 03:22:27	1.11
+++ /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-gtk.lisp	2006/02/16 18:20:53	1.12
@@ -1,5 +1,5 @@
 (defpackage :test-gtk
-  (:use :common-lisp :utils-kt :cells :gtk-ffi :cells-gtk #-clisp :ffx))
+  (:use :common-lisp :utils-kt :pod :cells :gtk-ffi :cells-gtk))
 
 (in-package :test-gtk)
 
@@ -34,14 +34,13 @@
     :stock-icons (list (list :my-g (namestring *stock-icon-image*)))
     :position :center
     :splash-screen-image (namestring *splash-image*)
-    :width 550 :height 550
+    :width 650 :height 550
     :kids (let ((tabs '("Buttons"
                         "Display" "Layout"
                         "Menus"
                         "Textview" "Dialogs" "Addon"
                         "Entry"
-                        "Tree-view"
-                        )))
+                        "Tree-view")))
             (list (mk-notebook 
                    :tab-labels tabs
                    :kids  (loop for test-name in tabs



From pdenno at common-lisp.net  Thu Feb 16 18:21:18 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 12:21:18 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk/test-gtk
Message-ID: <20060216182118.6E3D750012@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp:/tmp/cvs-serv10966/root/cells-gtk/test-gtk

Modified Files:
	test-textview.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-textview.lisp	2005/03/06 17:02:44	1.3
+++ /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-textview.lisp	2006/02/16 18:21:18	1.4
@@ -42,7 +42,7 @@
                       (string-downcase (symbol-name (gensym)))
                       (string-downcase (subseq (string name) (1+ (position #\- (string name)))))
                       (string-downcase (subseq (string name) 0 (position #\- (string name))))
-                      c-null))))
+                      +c-null+))))
       (loop for name in '(:red-foreground :red-background :yellow-foreground :yellow-background)
          do (create-tag name)))
     ht))



From pdenno at common-lisp.net  Thu Feb 16 21:55:32 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 15:55:32 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060216215532.E6F4A2A5C7@common-lisp.net>

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

Modified Files:
	gtk-ffi.lisp 
Log Message:
Added a troubling modification to cffi:translate-from-foreign-type for CLISP, :gtk-boolean

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/16 18:04:29	1.17
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/16 21:55:32	1.18
@@ -49,6 +49,7 @@
 
 (defconstant +c-null+ (cffi:null-pointer)) 
 (defvar *gtk-debug* nil)
+(defvar *zippy* "diagnostics")
 
 ;;; ==============  Define CFFI types, and their translations.... 
 (cffi:defctype :gtk-string :pointer :documentation "string type for cffi type translation")
@@ -58,7 +59,10 @@
   (cffi:make-pointer (if value 1 0)))
 
 (defmethod cffi:translate-from-foreign (value (type (eql :gtk-boolean)))
-  (not (zerop (cffi::pointer-address value)))) ; pod strange!
+  #-clisp(not (zerop (cffi::pointer-address value))) ; pod strange!
+  #+clisp(if (null value) ; pod something really wrong here!
+	     nil
+	   (not (zerop (cffi::pointer-address value)))))
 
 (defmethod cffi:translate-to-foreign (value (type (eql :gtk-string)))
   (when (null value) (setf value "")) ; pod ??? 
@@ -114,29 +118,31 @@
 ;;; After doing this, should be able to do (g-thread-init c-null)
 ;;; The above define-foreigh-library appears to be useless (doesn't
 ;;; work through the symbols) use the names. 
-(defun load-gtk-libs ()
-  (handler-bind ((style-warning #'muffle-warning))
-    (cffi:load-foreign-library #+linux "libgobject-2.0.so" 
-			       #+win32 "libgobject-2.0-0.dll" 
-			       #+macosx "libgobject-2.0-0.dylib")
-    (cffi:load-foreign-library #+linux "libglib-2.0.so" 
-			       #+win32 "libglib-2.0-0.dll" 
-			       #+macosx "libglib-2.0-0.dylib")
-    (cffi:load-foreign-library #+linux "libgthread-2.0.so" 
-			       #+win32 "libgthread-2.0-0.dll" 
-			       #+macosx "libgthread-2.0-0.dylib")
-    (cffi:load-foreign-library #+linux "libgdk-x11-2.0.so" 
-			       #+win32 "libgdk-win32-2.0-0.dll" 
-			       #+macosx "libgdk-win32-2.0-0.dylib")
-    (cffi:load-foreign-library #+linux "libgtk-x11-2.0.so" 
-			       #+win32 "libgtk-win32-2.0-0.dll" 
-			       #+macosx "libgtk-win32-2.0-0.dylib")
-    #+libcellsgtk
-    (cffi:load-foreign-library #+linux "libcellsgtk.so" 
-			       #+win32 "libcellsgtk.dll" 
-			       #+macosx "libcellsgtk.dylib")))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun load-gtk-libs ()
+    (handler-bind ((style-warning #'muffle-warning))
+      (cffi:load-foreign-library #+cffi-features:unix "libgobject-2.0.so" 
+				 #+win32 "libgobject-2.0-0.dll" 
+				 #+macosx "libgobject-2.0-0.dylib")
+      (cffi:load-foreign-library #+cffi-features:unix "libglib-2.0.so" 
+				 #+win32 "libglib-2.0-0.dll" 
+				 #+macosx "libglib-2.0-0.dylib")
+      (cffi:load-foreign-library #+cffi-features:unix "libgthread-2.0.so" 
+				 #+win32 "libgthread-2.0-0.dll" 
+				 #+macosx "libgthread-2.0-0.dylib")
+      (cffi:load-foreign-library #+cffi-features:unix "libgdk-x11-2.0.so" 
+				 #+win32 "libgdk-win32-2.0-0.dll" 
+				 #+macosx "libgdk-win32-2.0-0.dylib")
+      (cffi:load-foreign-library #+cffi-features:unix "libgtk-x11-2.0.so" 
+				 #+win32 "libgtk-win32-2.0-0.dll" 
+				 #+macosx "libgtk-win32-2.0-0.dylib")
+      #+libcellsgtk
+      (cffi:load-foreign-library #+cffi-features:unix "libcellsgtk.so" 
+				 #+win32 "libcellsgtk.dll" 
+				 #+macosx "libcellsgtk.dylib")))
+) ; eval
+
+(eval-when (:compile-toplevel :execute)
   (export '(+c-null+ int-slot-indexed load-gtk-libs))
   (defun gtk-function-name (lisp-name)
     (substitute #\_ #\- lisp-name))
@@ -178,15 +184,16 @@
 	 (when *gtk-debug*
 	   ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
 			(string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
-	      `(format *trace-output* "~%before (~A ~{~A~^ ~})" 
+	      `(format *trace-output* "~%Calling (~A ~{~A~^ ~})" 
 		       ,(string-downcase (string name)) (list ,@(mapcar 'car arguments)))))
-	 (prog1
-	     (,gtk-name ,@(mapcar #'car arguments))
+	 (let ((result (,gtk-name ,@(mapcar #'car arguments))))
 	   (when *gtk-debug*
 	     ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING")
 			  (string= (symbol-name name) "GTK-MAIN-ITERATION-DO"))
-	      `(format *trace-output* "~%after (~A ~{~A~^ ~})" 
-		       ,(string-downcase (string name)) (list ,@(mapcar 'car arguments)))))))
+	      `(format *trace-output* "~%  (~A ~{~A~^ ~}) returns ~A" 
+		       ,(string-downcase (string name)) (list ,@(mapcar 'car arguments))
+		       result)))
+	   result))
        (eval-when (:compile-toplevel :load-toplevel :execute)
 	 (export ',name)))))
 



From pdenno at common-lisp.net  Thu Feb 16 21:56:17 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 15:56:17 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060216215617.5E6CB80B0@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv3578/root/cells-gtk

Modified Files:
	gtk-app.lisp 
Log Message:
trivial

--- /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp	2006/02/16 18:15:14	1.16
+++ /project/cells-gtk/cvsroot/root/cells-gtk/gtk-app.lisp	2006/02/16 21:56:17	1.17
@@ -113,7 +113,7 @@
 	       (report-error-and-give-up (c) (error c))))
 	    ;; clean-up forms (takes down application).
 	    (not-to-be app) ; while (> (gtk-main-level) 0) do (gtk-main-quit) NG. Why?
-	    (loop for i from 0 to 99 do (gtk-main-quit))
+	    (loop for i from 0 to 30 do (gtk-main-quit))
 	    (loop while (gtk-events-pending) do (gtk-main-iteration-do nil)))))))
 
 ;;; Restarts



From pdenno at common-lisp.net  Thu Feb 16 22:18:09 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:18:09 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216221809.5D2124300F@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv9462

Modified Files:
	index.html 
Log Message:
update

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/11 03:52:17	1.18
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:18:09	1.19
@@ -74,7 +74,8 @@
 <h1 id='news'>News</h1>
 
 <ul>
-  <li> <strong>2006-02-10</strong> Source on CVS is updated to use CFFI 0.9 and all Hello-C code has been eliminated.</li>
+  <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a 
+       <a href="http://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>.
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port
@@ -121,6 +122,11 @@
       snapshots of the CVS repository, and contain all the ancillary modules (cells, cffi, etc). 
       Here are a few:
        <ul>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
+	   <ul>
+             <li>Native CFFI.</li>
+	     <li>More testing</li>
+           </ul>
          <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>
              <li>Uses CFFI, not Hello-C (See "News" above).</li>



From pdenno at common-lisp.net  Thu Feb 16 22:20:17 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:20:17 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216222017.A8D664801E@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv9561

Modified Files:
	index.html 
Log Message:
removed pub from path

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:18:09	1.19
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:20:17	1.20
@@ -75,7 +75,7 @@
 
 <ul>
   <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a 
-       <a href="http://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>.
+       <a href="http://common-lisp.net/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>.
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port
@@ -92,8 +92,8 @@
    If I didn't break anything, it also works with CLISP/PC and Lispworks/PC.</li>
   <li> <strong>2005-11-15</strong> We now provide the win32 .dll
    and linux .so for libcellsgtk. They are:
-   <a href="ftp://common-lisp.net/pub/project/cells-gtk/libcellsgtk.so">this for linux</a> and 
-   <a href="ftp://common-lisp.net/pub/project/cells-gtk/libcellsgtk.dll">this for win32</a>. 
+   <a href="ftp://common-lisp.net/project/cells-gtk/libcellsgtk.so">this for linux</a> and 
+   <a href="ftp://common-lisp.net/project/cells-gtk/libcellsgtk.dll">this for win32</a>. 
    This is sort of experimental. If you have problems (e.g. with version mismatch) drop the
    mailing list a note.</li>
  
@@ -122,12 +122,12 @@
       snapshots of the CVS repository, and contain all the ancillary modules (cells, cffi, etc). 
       Here are a few:
        <ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
              <li>Native CFFI.</li>
 	     <li>More testing</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>
              <li>Uses CFFI, not Hello-C (See "News" above).</li>
              <li>Runs under CLISP, Lispworks, CMUCL, SBCL, ACL and maybe others.</li>
@@ -139,7 +139,7 @@
              <li><strong>NOTE:</strong> This has only been tested with the lisps listed in the "News" above.
                  If it works elsewhere drop the mailing list a note.
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
 	   <ul>
              <li>ComboBoxes may now use a TreeModel; allows hierarchical arrangement of items. (requires libcellsgtk)</li>
              <li>Uses Cells 2</li>
@@ -147,7 +147,7 @@
              <li>New procedure to locate dynamic libraries. (Works 'out of the box' 50% of the time versus 10% before ???)
              <li>Has <em>not</em> been tested on Windows. Drop the group a note if you try it.</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
              </li>
        </ul>
      </li>



From pdenno at common-lisp.net  Thu Feb 16 22:21:56 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:21:56 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216222156.650FD4801E@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv9581

Modified Files:
	index.html 
Log Message:
added ftp to path

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:20:17	1.20
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:21:56	1.21
@@ -75,7 +75,7 @@
 
 <ul>
   <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a 
-       <a href="http://common-lisp.net/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>.
+       <a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">snapshot release</a>.
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port
@@ -92,8 +92,8 @@
    If I didn't break anything, it also works with CLISP/PC and Lispworks/PC.</li>
   <li> <strong>2005-11-15</strong> We now provide the win32 .dll
    and linux .so for libcellsgtk. They are:
-   <a href="ftp://common-lisp.net/project/cells-gtk/libcellsgtk.so">this for linux</a> and 
-   <a href="ftp://common-lisp.net/project/cells-gtk/libcellsgtk.dll">this for win32</a>. 
+   <a href="ftp://common-lisp.net/project/cells-gtk/ftp/libcellsgtk.so">this for linux</a> and 
+   <a href="ftp://common-lisp.net/project/cells-gtk/ftp/libcellsgtk.dll">this for win32</a>. 
    This is sort of experimental. If you have problems (e.g. with version mismatch) drop the
    mailing list a note.</li>
  
@@ -122,12 +122,12 @@
       snapshots of the CVS repository, and contain all the ancillary modules (cells, cffi, etc). 
       Here are a few:
        <ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
              <li>Native CFFI.</li>
 	     <li>More testing</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>
              <li>Uses CFFI, not Hello-C (See "News" above).</li>
              <li>Runs under CLISP, Lispworks, CMUCL, SBCL, ACL and maybe others.</li>
@@ -139,7 +139,7 @@
              <li><strong>NOTE:</strong> This has only been tested with the lisps listed in the "News" above.
                  If it works elsewhere drop the mailing list a note.
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
 	   <ul>
              <li>ComboBoxes may now use a TreeModel; allows hierarchical arrangement of items. (requires libcellsgtk)</li>
              <li>Uses Cells 2</li>
@@ -147,7 +147,7 @@
              <li>New procedure to locate dynamic libraries. (Works 'out of the box' 50% of the time versus 10% before ???)
              <li>Has <em>not</em> been tested on Windows. Drop the group a note if you try it.</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
+         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
              </li>
        </ul>
      </li>



From pdenno at common-lisp.net  Thu Feb 16 22:35:11 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:35:11 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216223511.B91A24E015@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv11089

Modified Files:
	index.html 
Log Message:
one more time

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:21:56	1.21
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:35:11	1.22
@@ -75,7 +75,7 @@
 
 <ul>
   <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a 
-       <a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">snapshot release</a>.
+       <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">snapshot release</a>.
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port
@@ -92,8 +92,8 @@
    If I didn't break anything, it also works with CLISP/PC and Lispworks/PC.</li>
   <li> <strong>2005-11-15</strong> We now provide the win32 .dll
    and linux .so for libcellsgtk. They are:
-   <a href="ftp://common-lisp.net/project/cells-gtk/ftp/libcellsgtk.so">this for linux</a> and 
-   <a href="ftp://common-lisp.net/project/cells-gtk/ftp/libcellsgtk.dll">this for win32</a>. 
+   <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/libcellsgtk.so">this for linux</a> and 
+   <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/libcellsgtk.dll">this for win32</a>. 
    This is sort of experimental. If you have problems (e.g. with version mismatch) drop the
    mailing list a note.</li>
  
@@ -122,12 +122,12 @@
       snapshots of the CVS repository, and contain all the ancillary modules (cells, cffi, etc). 
       Here are a few:
        <ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
              <li>Native CFFI.</li>
 	     <li>More testing</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>
              <li>Uses CFFI, not Hello-C (See "News" above).</li>
              <li>Runs under CLISP, Lispworks, CMUCL, SBCL, ACL and maybe others.</li>
@@ -139,7 +139,7 @@
              <li><strong>NOTE:</strong> This has only been tested with the lisps listed in the "News" above.
                  If it works elsewhere drop the mailing list a note.
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
 	   <ul>
              <li>ComboBoxes may now use a TreeModel; allows hierarchical arrangement of items. (requires libcellsgtk)</li>
              <li>Uses Cells 2</li>
@@ -147,7 +147,7 @@
              <li>New procedure to locate dynamic libraries. (Works 'out of the box' 50% of the time versus 10% before ???)
              <li>Has <em>not</em> been tested on Windows. Drop the group a note if you try it.</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/project/cells-gtk/ftp/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
              </li>
        </ul>
      </li>



From pdenno at common-lisp.net  Thu Feb 16 22:37:19 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:37:19 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216223719.586C94E015@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv11111

Modified Files:
	index.html 
Log Message:
again

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:35:11	1.22
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:37:19	1.23
@@ -75,7 +75,7 @@
 
 <ul>
   <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a 
-       <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">snapshot release</a>.
+       <a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>.
   <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a>
    and uses <a href="http://common-lisp.net/project/cffi/">CFFI</a>, not Hello-c for its foreign function interface. 
    The 2006-01-03 tarball reflects these changes. Especial thanks to Novikov Leonid, who did the CLISP port
@@ -92,8 +92,8 @@
    If I didn't break anything, it also works with CLISP/PC and Lispworks/PC.</li>
   <li> <strong>2005-11-15</strong> We now provide the win32 .dll
    and linux .so for libcellsgtk. They are:
-   <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/libcellsgtk.so">this for linux</a> and 
-   <a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/libcellsgtk.dll">this for win32</a>. 
+   <a href="ftp://common-lisp.net/pub/project/cells-gtk/libcellsgtk.so">this for linux</a> and 
+   <a href="ftp://common-lisp.net/pub/project/cells-gtk/libcellsgtk.dll">this for win32</a>. 
    This is sort of experimental. If you have problems (e.g. with version mismatch) drop the
    mailing list a note.</li>
  
@@ -122,12 +122,12 @@
       snapshots of the CVS repository, and contain all the ancillary modules (cells, cffi, etc). 
       Here are a few:
        <ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
              <li>Native CFFI.</li>
 	     <li>More testing</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>
              <li>Uses CFFI, not Hello-C (See "News" above).</li>
              <li>Runs under CLISP, Lispworks, CMUCL, SBCL, ACL and maybe others.</li>
@@ -139,7 +139,7 @@
              <li><strong>NOTE:</strong> This has only been tested with the lisps listed in the "News" above.
                  If it works elsewhere drop the mailing list a note.
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2005-05-29.tgz">cells-gtk-2005-05-29.tgz</a>
 	   <ul>
              <li>ComboBoxes may now use a TreeModel; allows hierarchical arrangement of items. (requires libcellsgtk)</li>
              <li>Uses Cells 2</li>
@@ -147,7 +147,7 @@
              <li>New procedure to locate dynamic libraries. (Works 'out of the box' 50% of the time versus 10% before ???)
              <li>Has <em>not</em> been tested on Windows. Drop the group a note if you try it.</li>
            </ul>
-         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/ftp/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
+         <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2005-02-26.tgz">cells-gtk-2005-02-26.tgz</a>
              </li>
        </ul>
      </li>



From pdenno at common-lisp.net  Thu Feb 16 22:39:46 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:39:46 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216223946.669674E016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv11145

Modified Files:
	index.html 
Log Message:
again2

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:37:19	1.23
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:39:46	1.24
@@ -124,8 +124,8 @@
        <ul>
          <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
-             <li>Native CFFI.</li>
-	     <li>More testing</li>
+             <li>Native CFFI. (That is, not Hello-C to UFFI, to CFFI-UFFI-COMPAT (yuk!).</li>
+	     <li>More testing, testing of CLISP/Windows 2000</li>
            </ul>
          <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
 	   <ul>



From pdenno at common-lisp.net  Thu Feb 16 22:41:45 2006
From: pdenno at common-lisp.net (pdenno)
Date: Thu, 16 Feb 2006 16:41:45 -0600 (CST)
Subject: [cells-gtk-cvs] CVS public_html
Message-ID: <20060216224145.35DD82A5C7@common-lisp.net>

Update of /project/cells-gtk/cvsroot/public_html
In directory common-lisp:/tmp/cvs-serv11257

Modified Files:
	index.html 
Log Message:
again3

--- /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:39:46	1.24
+++ /project/cells-gtk/cvsroot/public_html/index.html	2006/02/16 22:41:45	1.25
@@ -124,7 +124,7 @@
        <ul>
          <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">cells-gtk-2006-02-16.tgz</a>
 	   <ul>
-             <li>Native CFFI. (That is, not Hello-C to UFFI, to CFFI-UFFI-COMPAT (yuk!).</li>
+             <li>Native CFFI. That is, not Hello-C to UFFI, to CFFI-UFFI-COMPAT (yuk!).</li>
 	     <li>More testing, testing of CLISP/Windows 2000</li>
            </ul>
          <li><a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-01-03.tgz">cells-gtk-2006-01-03.tgz</a>
@@ -160,7 +160,7 @@
 
   <li><strong>Original CLISP Code:</strong> Now that CLISP is back in
       the main tree, this isn't the place to start but just in case we screwed something up
-      and you want to have a look, its
+      and you want to have a look, it's
       <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/root/?cvsroot=cells-gtk">here</a>
       via CVS or the "Download tarball" link at the bottom of that page.
        Follow instructions in the include INSTALL.TXT.</li>



From pdenno at common-lisp.net  Sun Feb 19 20:06:40 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:06:40 -0600 (CST)
Subject: [cells-gtk-cvs] CVS 
Message-ID: <20060219200640.567F570010@common-lisp.net>

Update of /project/cells-gtk/cvsroot
In directory common-lisp:/tmp/cvs-serv14381

Modified Files:
	INSTALL.TXT 
Log Message:
Update lisp implementation list

--- /project/cells-gtk/cvsroot/INSTALL.TXT	2006/02/16 18:09:31	1.2
+++ /project/cells-gtk/cvsroot/INSTALL.TXT	2006/02/19 20:06:40	1.3
@@ -18,14 +18,15 @@
 
 TESTED ON:
     Windows XP: (with gtk 2.4.10) 
-      ---> 2005-05-29 tarball not tested on Windows.
-      AllegroCL 6.2 Enterprise, 
-      Lispworks 4.3 Personal
+       AllegroCL 6.2 Enterprise, 
+       Lispworks 4.3 Personal
+    Windows 2000:
+       CLISP 2.38
     Linux: 
-     Lispworks 4.4 Pro, 
-     CMUCL 19c, 
-     CLISP 2.36
-     SBCL 0.9.9.1
+      Lispworks 4.4 Pro, 
+      CMUCL 19c, 
+      CLISP 2.36
+      SBCL 0.9.9.1
 
 NOT TESTED SINCE SWITCHING TO CFFI: (as of 2006-01-03):
     AllegroCL



From pdenno at common-lisp.net  Sun Feb 19 20:07:07 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:07:07 -0600 (CST)
Subject: [cells-gtk-cvs] CVS 
Message-ID: <20060219200707.0D7EC70010@common-lisp.net>

Update of /project/cells-gtk/cvsroot
In directory common-lisp:/tmp/cvs-serv14413

Modified Files:
	load.lisp 
Log Message:
load pod-utils

--- /project/cells-gtk/cvsroot/load.lisp	2006/01/03 19:13:50	1.1
+++ /project/cells-gtk/cvsroot/load.lisp	2006/02/19 20:07:06	1.2
@@ -27,6 +27,7 @@
         (list #P"cells-gtk:"
               #P"cells-gtk:cells;"
               #P"cells-gtk:cffi;"
+              #P"cells-gtk:root;pod-utils;"
               #P"cells-gtk:root;gtk-ffi;"
               #P"cells-gtk:root;cells-gtk;"
               #P"cells-gtk:root;cells-gtk;test-gtk;")))



From pdenno at common-lisp.net  Sun Feb 19 20:08:18 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:08:18 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/pod-utils
Message-ID: <20060219200818.38BC070011@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/pod-utils
In directory common-lisp:/tmp/cvs-serv14510/root/pod-utils

Log Message:
Directory /project/cells-gtk/cvsroot/root/pod-utils added to the repository





From pdenno at common-lisp.net  Sun Feb 19 20:09:12 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:09:12 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/pod-utils
Message-ID: <20060219200912.55A1970011@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/pod-utils
In directory common-lisp:/tmp/cvs-serv14536/root/pod-utils

Added Files:
	pod-utils.asd utils.lisp 
Log Message:
New files


--- /project/cells-gtk/cvsroot/root/pod-utils/pod-utils.asd	2006/02/19 20:09:12	NONE
+++ /project/cells-gtk/cvsroot/root/pod-utils/pod-utils.asd	2006/02/19 20:09:12	1.1

(asdf:defsystem :pod-utils
  :name "pod-utils"
  :components
  ((:file "utils")))
--- /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp	2006/02/19 20:09:12	NONE
+++ /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp	2006/02/19 20:09:12	1.1

;;; Copyright (c) 2004 Peter Denno
;;;
;;; Permission is hereby granted, free of charge, to any person
;;; obtaining a copy of this software and associated documentation
;;; files (the "Software"), to deal in the Software without restriction,
;;; including without limitation the rights to use, copy, modify,
;;; merge, publish, distribute, sublicense, and/or sell copies of the
;;; Software, and to permit persons to whom the Software is furnished
;;; to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
;;; ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
;;; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;;-----------------------------------------------------------------------

;;;
;;; Peter Denno
;;;  Date: 12/2/95 - on going.
;;;
;;; Generally applicable utilities. Some from Norvig's "Paradigms of
;;; Artificial Programming," Some from Kiczales et. al. "The Art of the
;;; Metaobject Protocol," some from Graham's "On Lisp," some from Sam Steingold.
;;;
(in-package :cl-user)

(defpackage pod-utils
  (:nicknames pod)
  (:use cl)
  (:export combinations flatten kintern sintern mapappend pairs memo debug-memo memoize 
	   clear-memoize defun-memoize VARS mac mac2 load-ht when-bind if-bind when-bind* 
	   substring remove-extra-spaces break-line-at read-string-to-list split 
	   name2initials c-name2lisp lisp-name2c single-p mklist longer group prune find2 before 
	   duplicate split-if mvb mvs dbind decode-time-interval strcat now tree-search depth-first-search 
	   prepend breadth-first-search update with-stack-size pprint-without-strings chop setx
	   new-reslist reslist-pop reslist-push reslist-fillptr reuse-cons intersect-predicates
	   defmemo system-clear-memoized-fns system-add-memoized-fn system-list-memoized-fns
	   system-forget-memoized-fns with-gensyms last1 fail trc))

(in-package :pod-utils)

;;; Purpose: Return the combinations possible when selecting one item
;;;          from each of the argument sets.
;;;         Example: (combinations '(a) '(b c) '(d e))
;;;                   => ((A B D) (A B E) (A C D) (A C E))
;;; Arg: sets - lists
;;; Value: a list of lists. If the argument is nil, it returns nil.
(defun combinations (&rest sets)
  (cond ((null sets) nil)
	(t 
	 (flet ((combinations-aux (aset bset)
		  (cond ((not aset) bset)
			((not bset) aset)
			(t (loop for a in aset
				 append (loop for b in bset
					      collect (list a b)))))))
	   (loop for set in (reduce #'combinations-aux sets)
		 collect (flatten set))))))

(defun flatten (input &optional accumulator)
  "Return a flat list of the atoms in the input.
   Ex: (flatten '((a (b (c) d))) => (a b c d))"
  (cond ((null input) accumulator)
	((atom input) (cons input accumulator))
	(t (flatten (first input)
		    (flatten (rest input) accumulator)))))

(declaim (inline kintern))
(defun kintern (string &rest args)
  "Apply FORMAT to STRING and ARGS, upcase the resulting string and
 intern it into the KEYWORD package."
  (intern (string-upcase (apply #'format nil (string string) args))
	  (find-package "KEYWORD")))

(declaim (inline sintern))
(defun sintern (string &rest args)
  "Apply FORMAT to STRING and ARGS, upcase the resulting string and
 intern it into the current (*PACKAGE*) package."
  (intern (string-upcase (apply #'format nil (string string) args))))

(defun mapappend (fun &rest args)
  (loop until (some #'null args)
	append (apply fun (loop for largs on args
				collect (pop (first largs))))))

(defun mapnconc (fun &rest args)
  (loop until (some #'null args)
	nconc (apply fun (loop for largs on args
				collect (pop (first largs))))))

;;; Purpose: Return a list of pairs of elements from the argument list:
;;; Ex: (pairs '(a b c d)) => ((a b) (a c) (a d) (b c) (b d) (c d))
;;;
;;; Args: inlist - a list
(defun pairs (inlist)
  (loop for sublist on inlist
	while (cdr sublist)
	append
	(loop for elem in (cdr sublist)
	      collect `(,(first sublist) ,elem))))

;;; Purpose: Called by memoize, below. This returns
;;;          the memoized function. Norvig, Page 270.
;;; When you want to use this on &rest args use :test #'equal :key #'identity
;;; Args: fn - the function object.
;;;       name - the function symbol.
;;;       key - On what argument the result is indexed.
;;;       test - Either eql or equal, the :test of the hash table.
(defun memo (fn name key test)
  "Return a memo-function of fn."
  (let ((table (make-hash-table :test test)))
    (setf (get name 'memo) table)
    #'(lambda (&rest args)
	(let ((k (funcall key args)))
	  (multiple-value-bind (val found-p)
	      (gethash k table)
	    (if found-p
		val
	      (setf (gethash k table) (apply fn args))))))))

(defun debug-memo (fn name key test)
  "Like memo but prints *hit* on every hit."
  (let ((table (make-hash-table :test test)))
    (setf (get name 'memo) table)
    #'(lambda (&rest args)
	(let ((k (funcall key args)))
	  (multiple-value-bind (val found-p)
	      (gethash k table)
	    (if found-p
		(progn (princ " *HIT*") val)
	      (progn
		(princ " *miss*")
		(setf (gethash k table) (apply fn args)))))))))

;;; Purpose: memoize the argument function.
;;; Arguments as those in memo.
(defun memoize (fn-name &key (key #'first) (test #'eql) (debug nil))
  "Replace fn-name's global definition with a memoized version."
	  #-Allegro-V4.3 (format t "~%;;; Memoizing (~a) ~a ****" test fn-name)
	  #+Allegro-V4.3 (format t "~%;;; Memoizing ~a ****" fn-name)
  (if debug
      (setf (symbol-function fn-name)
	    (debug-memo (symbol-function fn-name) fn-name key test))
    (setf (symbol-function fn-name)
	  (memo (symbol-function fn-name) fn-name key test))))

;;; Clear the hash table from the function.
(defun clear-memoize (fn-name)
  "Clear the hash table from a memo function."
  (let ((table (get fn-name 'memo)))
    (when table (clrhash table))))

;;; Purpose: define a function and memoize it.
;;; Limitations: only useful for default arguments, i.e.,
;;;              key on first and test eql. In all other
;;;              cases call (memoize <fn> :key <key> :test <test>).
(defmacro defun-memoize (fn args &body body)
  `(memoize (defun ,fn ,args ,body)))

;;; Stuff to use when you have a serious number of memoized functions,
;;; and you have a notion of "starting over." 
(defmacro defmemo (fname &body body)
  `(progn (defun ,fname , at body)
     (eval-when (:load-toplevel)
       (memoize ',fname)
       (system-add-memoized-fn ',fname))))

(let ((+memoized-fns+ nil))
  (defun system-clear-memoized-fns ()
    (mapcar #'(lambda (x) 
                (warn "Clearing memoized ~A" x) 
                (clear-memoize x))
            +memoized-fns+))
  (defun system-add-memoized-fn (fname)
    (pushnew fname +memoized-fns+))
  (defun system-list-memoized-fns ()
    +memoized-fns+)
  (defun system-forget-memoized-fns ()
    (setf +memoized-fns+ nil))
)

;;; Purpose: Diagnostic (From Howard Stearns) that does
;;; (vars a b c) => (FORMAT *TRACE-OUTPUT* "~&a = ~S b = ~S c = ~S ~%" A B C)
(defmacro VARS (&rest variables)
  `(format *trace-output*
           ,(loop with result = "~&"
                  for var in variables
                  do
                  (setf result
                        (if (and (consp var)
                                 (eq (first var) 'quote))
                            (concatenate 'string result " ~S ")
                          (concatenate 'string result (string-downcase var) " = ~S ")))
                  finally (return (concatenate 'string result "~%")))
           , at variables))

;;; The most essential macro building tool.
(defmacro mac (macro)
  `(pprint (macroexpand-1 ',macro)))

;;; Similar, but used on 'subtype' macros. 
(defmacro mac2 (macro)
  `(pprint (macroexpand-1 (macroexpand-1 ',macro))))

;;; Dirk H.P. Gerrits' "Lisp Code Walker" slides, ALU Meeting, Amsterdam, 2003. 
;;; With additional corrections (beyond that in his notes). 
(defvar *mea-hooks* (make-hash-table :test #'eq))
(defun macroexpand-all (form &optional env)
  "Macroexpand FORM recursively until none of its subforms can be further expanded."
  (multiple-value-bind (expansion macrop)
      (macroexpand-1 form env)
    (declare (ignore macrop))
    (let* ((key (and (consp form) (car form)))
           (hook (gethash key *mea-hooks*)))
      (cond (hook (funcall hook form env))
            ((and (consp form) (symbolp (car form)) (macro-function (car form)))
             (macroexpand-all expansion env))
            ((consp form) (cons (car form)
                                (mapcar #'(lambda (arg)
                                            (macroexpand-all arg env))
                                        (cdr form))))
            (t expansion)))))

(defun load-ht (ht key-value-pairs)
  "Load the argument hash table with the argument values
   provided in a flat list of <key> <value>. "
  (loop while key-value-pairs
	do
	(setf (gethash (pop key-value-pairs) ht)
	      (pop key-value-pairs)))
  ht)
  
(defmacro when-bind ((var expr) &body body)
  "Paul Graham ON LISP pg 145. when+let"
  `(let ((,var ,expr))
     (when ,var
       , at body)))

(defmacro if-bind ((var expr) then else)
  `(let ((,var ,expr))
     (if ,var
         ,then 
       ,else)))

(defmacro when-bind* (binds &body body)
  "Paul Graham ON LISP pg 145. when+let*"
  (if (null binds)
      `(progn @body)
    `(let (,(car binds))
       (if ,(caar binds)
	   (when-bind* ,(car binds) , at body)))))

(defmacro with-gensyms (syms &body body)
  "Paul Graham ON LISP pg 145. Used in macros to avoid variable capture."
  `(let ,(mapcar #'(lambda (s) 
		     `(,s (gensym)))
	  syms)
     , at body))

(declaim (inline substring))
(defun substring (str1 str2)
  "Returns the place in str1 where str2 begins or nil if str2 is not in str1"
  (search str2 str1 :test #'string=))

(defun remove-extra-spaces (string)
  "Leave only one space between non-space characters of argument string."
  (let* ((len (length string))
         (new-string (make-array len :element-type 'character :fill-pointer 0)))
    (vector-push (char string 0) new-string)
    (loop for i from 1 to (1- len)
          unless (and (char= #\Space (char string i))
                      (char= #\Space (char string (1- i))))
          do (vector-push (char string i) new-string))
    new-string))

(defun break-line-at (string break-bag position)
  "Return the argument STRING with linefeeds inserted at some position past POSITION
   where a character in the break-bag is encountered."
  (let* ((len (length string))
         (new-string (make-array (* 2 len) :element-type 'character :fill-pointer 0)))
    (loop for ix from 0 to (1- (length string))
          with count = 0
          do (vector-push (char string ix) new-string)
          (incf count)
          when (and (> count position)
                    (find (char string ix) break-bag))
          do (vector-push #\Linefeed new-string)
          (setf count 0)
          finally (return new-string))))

(defun read-string-to-list (string)
  (loop with val = nil and start = 0
	do (multiple-value-setq (val start)
	     (read-from-string string nil :eof :start start))
	until (eql val :eof)
	collect val))


;;; (cl-ppcre:split "\\s+" "foo   bar baz frob")
;;; ("foo" "bar" "baz" "frob") 
;;; http://weitz.de/cl-ppcre/#split
(defun split (string c &key min-size)
  "Like the perl split, split the string using the character. Return
   a list of substrings."
  (let ((result
         (loop for i from 0 to (1- (length string))
               with start = 0 with size = 0
	       do (incf size)
               when (and (char= c (char string i))
			 (or (not min-size)
			     (> size min-size)))
               collect (subseq string start i) into result
               and do (setf start (1+ i) size 0)
               finally (return (append result (list (subseq string start)))))))
    (if (zerop (length (first (last result))))
        (butlast result)
      result)))

(defun name2initials (string)
  "For 'abc' return 'a'. For 'product_definition_formation' return 'pdf', etc."
  (let ((result (make-array 31 :element-type 'character :fill-pointer 0))
        (len (length string)))
    (vector-push (char string 0) result)
    (loop for i from 1 to (1- len)
          when (and (char= (char string i) #\_) (< i (1- len))) do
          (vector-push (char string (+ i 1)) result)
          (incf i))
    result))

(defun c-name2lisp (c-string)
  "aNameLikeThis --> a-name-like-this"
  (let* ((len (length c-string))
         (result (make-array (* 2 len) :element-type 'character :fill-pointer 0)))
    (vector-push (char c-string 0) result)
    (loop for i from 1 to (1- len)
          for char = (char c-string i) do		  
          (when (upper-case-p char) (vector-push #\- result))
          (vector-push char result))
    (string-downcase result)))

(defun lisp-name2c (in-string &aux (lisp-string (string-downcase in-string)))
  "a-name-like-this --> aNameLikeThis"
  (let* ((len (length lisp-string))
	 (result (make-array len :element-type 'character :fill-pointer 0)))
    (vector-push (char lisp-string 0) result)
    (loop for i from 1 to (1- len)
	  for char = (char lisp-string i)
          with upper-next = nil do		  
	  (cond ((char= char #\-) 
                 (setf upper-next t))
                (t (vector-push (if upper-next (char-upcase char) char) result)
                   (setf upper-next nil))))
    result))

;;;=============================================
;;; A bunch more from Paul Grahams's "On Lisp."
;;;=============================================
(declaim (inline single-p last1 mklist))

(defun single-p (lst)
  "List contains just one thing."
  (and (consp lst) (not (cdr lst))))

(defun last1 (lst)
  (car (last lst)))

(defun mklist (obj)
  "Make the argument a list if it isn't already."
  (if (listp obj) obj (list obj)))

(defun longer (x y)
  "Return true if x longer than y -- only for lists."
  (labels ((compare (x y)
             (and (consp x)
                  (or (null y)
                      (compare (cdr x) (cdr y))))))
    (if (and (listp x) (listp y))
        (compare x y)
      (> (length x) (length y)))))

(defun group (source n)
  (if (zerop n) (error "zero length"))
  (labels ((rec (source acc)
             (let ((rest (nthcdr n source)))
               (if (consp rest)
                   (rec rest (cons (subseq source 0 n) acc))
                 (nreverse (cons source acc))))))
    (if source (rec source nil) nil)))

[374 lines skipped]


From pdenno at common-lisp.net  Sun Feb 19 20:09:57 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:09:57 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219200957.0355770011@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14562/root/cells-gtk

Modified Files:
	addon.lisp 
Log Message:
Use uffi package prefix 

--- /project/cells-gtk/cvsroot/root/cells-gtk/addon.lisp	2004/12/06 20:04:12	1.3
+++ /project/cells-gtk/cvsroot/root/cells-gtk/addon.lisp	2006/02/19 20:09:57	1.4
@@ -27,10 +27,10 @@
                      (setf (md-value self) (get-date self))))
 
 (defmethod get-date ((self calendar))
-  (with-foreign-objects ((year :int)(month :int)(day :int))
+  (uffi:with-foreign-objects ((year :int)(month :int)(day :int))
     (gtk-calendar-get-date (id self) year month day)
-    (encode-universal-time 0 0 0 (deref-pointer day :int)
-      (1+ (deref-pointer month :int)) (deref-pointer year :int))))
+    (encode-universal-time 0 0 0 (uffi:deref-pointer day :int)
+      (1+ (uffi:deref-pointer month :int)) (uffi:deref-pointer year :int))))
 
 (def-c-output init ((self calendar))
   (when new-value



From pdenno at common-lisp.net  Sun Feb 19 20:10:27 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:10:27 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201027.F046873016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14657/root/cells-gtk

Modified Files:
	cells-gtk.asd 
Log Message:
:depends-on :pod-utils

--- /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd	2006/02/16 18:11:08	1.7
+++ /project/cells-gtk/cvsroot/root/cells-gtk/cells-gtk.asd	2006/02/19 20:10:27	1.8
@@ -2,7 +2,7 @@
 
 (asdf:defsystem :cells-gtk
   :name "cells-gtk"
-  :depends-on (:cells :gtk-ffi)
+  :depends-on (:cells :pod-utils :gtk-ffi)
   :serial t
   :components
   ((:file "packages")   



From pdenno at common-lisp.net  Sun Feb 19 20:11:03 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:11:03 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201103.381D173016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14676/root/cells-gtk

Modified Files:
	drawing.lisp 
Log Message:
Use pod-utils

--- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/02/16 18:13:57	1.5
+++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp	2006/02/19 20:11:03	1.6
@@ -19,7 +19,7 @@
 (cffi:defcallback drawing-expose-event-handler :int
   ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data signal gkd-event-expose widget))
-  (bwhen (self (gtk-object-find drawing-area))
+  (when-bind (self (gtk-object-find drawing-area))
     (init-graphics-context drawing-area)
     (gdk-draw-drawable
      *window*
@@ -31,7 +31,7 @@
 (cffi:defcallback drawing-button-events-handler :int
   ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data))
-  (bwhen (self (gtk-object-find drawing-area))
+  (when-bind (self (gtk-object-find drawing-area))
     (let ((event (gdk-event-button-type signal)))
       (when (and (eql (event-type event) :button_press)
                  (= (gdk-event-button-button signal) 1))
@@ -47,8 +47,8 @@
 (cffi:defcallback drawing-pointer-motion-handler :int
   ((drawing-area :pointer) (signal :pointer) (data :pointer))
   (declare (ignorable data signal widget))
-  (bwhen (self (gtk-object-find drawing-area))
-    (bwhen (button1 (button1-down self))
+  (when-bind (self (gtk-object-find drawing-area))
+    (when-bind (button1 (button1-down self))
       (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1)))
             (dy(- (truncate (gdk-event-motion-y signal)) (cdr button1))))
         (loop for drawable being the hash-value of (gobjects self) do



From pdenno at common-lisp.net  Sun Feb 19 20:11:45 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:11:45 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201145.F3BDA73022@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14701/root/cells-gtk

Modified Files:
	layout.lisp 
Log Message:
uffi --> cffi

--- /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp	2006/02/16 18:15:47	1.7
+++ /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp	2006/02/19 20:11:45	1.8
@@ -217,10 +217,10 @@
        (:bottom 3)
        (t 2)))))
 
-(defun notebook-contains-page-p (notebook widget &aux (wid (pointer-address (id widget))))
+(defun notebook-contains-page-p (notebook widget &aux (wid (cffi:pointer-address (id widget))))
   (loop for i from 1 to (gtk-notebook-get-n-pages (id notebook))
 	for page = (gtk-notebook-get-nth-page (id notebook) (1- i))
-	when (= wid (pointer-address page)) return t))
+	when (= wid (cffi:pointer-address page)) return t))
 
 (def-c-output show-page ((self notebook))
   (when (and new-value (>= new-value 0) (< new-value (length (kids self))))



From pdenno at common-lisp.net  Sun Feb 19 20:12:16 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:12:16 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201216.DE66073016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14720/root/cells-gtk

Modified Files:
	menus.lisp 
Log Message:
use pod-utils

--- /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp	2006/02/16 18:16:28	1.12
+++ /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp	2006/02/19 20:12:16	1.13
@@ -78,12 +78,12 @@
 				     '(:string :string) pfunc (children-fn self)))
       ;; Spec says iter must correspond to a path of depth one. But then there would be no point 
       ;; in set-active-iter.  Well, the spec seems to be wrong (or poorly worded).
-      (bwhen (path (init self))
+      (when-bind (path (init self))
 	     (cgtk-set-active-item-by-path self path)))))
 
 (defmethod cgtk-set-active-item-by-path ((self combo-box) path)
   "Sets the value of the tree-model type combo-box to the item at the path. Path is a list of integers."
-  (bwhen (tree (tree-model self))
+  (when-bind (tree (tree-model self))
     (with-tree-iters (it)
        (when (gtk-tree-model-get-iter-from-string (id tree) it (format nil "~{~A~^:~}" path))
 	 (gtk-combo-box-set-active-iter (id self) it)
@@ -97,7 +97,7 @@
   (when new-value
     (dolist (item (items self))
       (gtk-combo-box-append-text (id self) (funcall (print-fn self) item)))
-    (bif (index (position (init self) (items self)))
+    (if-bind (index (position (init self) (items self)))
 	 (progn (gtk-combo-box-set-active (id self) index)
 		(setf (md-value self) (init self)))
 	 (progn (gtk-combo-box-set-active (id self) 0)



From pdenno at common-lisp.net  Sun Feb 19 20:12:59 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:12:59 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201259.145C573016@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14740/root/cells-gtk

Modified Files:
	packages.lisp 
Log Message:
package does not use :ukt or :uffi

--- /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/02/16 18:16:55	1.4
+++ /project/cells-gtk/cvsroot/root/cells-gtk/packages.lisp	2006/02/19 20:12:58	1.5
@@ -18,7 +18,7 @@
 
 (defpackage :cells-gtk
   (:nicknames :cgtk)
-  (:use :common-lisp :utils-kt :pod :cells :gtk-ffi :uffi ))
+  (:use :common-lisp :pod :cells :gtk-ffi))
 
 
 



From pdenno at common-lisp.net  Sun Feb 19 20:13:26 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:13:26 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201326.BC2C52A01A@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14761/root/cells-gtk

Modified Files:
	textview.lisp 
Log Message:
use pod-utils

--- /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/02/16 18:17:22	1.8
+++ /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp	2006/02/19 20:13:26	1.9
@@ -72,8 +72,8 @@
 (cffi:defcallback text-view-populate-popup-handler :void
                   ((widget :pointer) (signal :pointer) (data :pointer))
   (let ((popup-menu (gtk-adds-text-view-popup-menu widget)))
-    (bwhen (text-view (gtk-object-find widget))
-      (bwhen (cb (callback-recover text-view :populate-popup))
+    (when-bind (text-view (gtk-object-find widget))
+      (when-bind (cb (callback-recover text-view :populate-popup))
         (funcall cb popup-menu))))
   1)
 
@@ -93,7 +93,7 @@
                  item)))
       #'(lambda (popup-menu)
           (loop for old in (old-popups text-view) do 
-               (bwhen (sub (submenu old)) 
+               (when-bind (sub (submenu old)) 
                  (gtk-object-forget (id sub) sub))
                (gtk-object-forget (id old) old))
           (let ((tops (mapcar #'do-padds p-adds)))



From pdenno at common-lisp.net  Sun Feb 19 20:13:51 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:13:51 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201351.E9F852A01A@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14780/root/cells-gtk

Modified Files:
	tree-view.lisp 
Log Message:
use pod-utils

--- /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/02/16 18:18:02	1.14
+++ /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp	2006/02/19 20:13:51	1.15
@@ -113,7 +113,7 @@
 
 (cffi:defcallback tree-view-select-handler :void
  ((column-widget :pointer) (event :pointer) (data :pointer))
-  (bif (tree-view (gtk-object-find column-widget))
+  (if-bind (tree-view (gtk-object-find column-widget))
        (let ((cb (callback-recover tree-view :on-select)))
          (funcall cb tree-view column-widget event data))
        (trc "Clean up old widgets after runs" column-widget))
@@ -211,7 +211,7 @@
 (cffi:defcallback tree-view-render-cell-callback :int
   ((tree-column :pointer) (cell-renderer :pointer) (tree-model :pointer) 
    (iter :pointer) (data :pointer))
-  (bif (self (gtk-object-find tree-column))
+  (if-bind (self (gtk-object-find tree-column))
        (let ((cb (callback-recover self :render-cell)))
          (assert cb nil "no :render-cell callback for ~a" self)
          (funcall cb tree-column cell-renderer tree-model iter data))



From pdenno at common-lisp.net  Sun Feb 19 20:14:26 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:14:26 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk
Message-ID: <20060219201426.1E8EF2A01A@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp:/tmp/cvs-serv14819/root/cells-gtk

Modified Files:
	widgets.lisp 
Log Message:
uffi --> cffi 

--- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/02/16 18:18:56	1.17
+++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp	2006/02/19 20:14:26	1.18
@@ -52,7 +52,7 @@
 (defun gtk-objects-init ()
   (setf *gtk-objects* (make-hash-table :size 100 :rehash-size 100)))
 
-(defun gtk-object-store (gtk-id gtk-object &aux (hash-id (pointer-address gtk-id)))
+(defun gtk-object-store (gtk-id gtk-object &aux (hash-id (cffi:pointer-address gtk-id)))
   (unless *gtk-objects*
     (gtk-objects-init))
   (let ((known (gethash hash-id *gtk-objects*)))
@@ -68,10 +68,10 @@
 (defun gtk-object-forget (gtk-id gtk-object)
   (when gtk-id
     (assert *gtk-objects*)
-    (remhash (pointer-address gtk-id) *gtk-objects*)
+    (remhash (cffi:pointer-address gtk-id) *gtk-objects*)
     (mapc #'(lambda (k) (gtk-object-forget (id k) k)) (kids gtk-object))))
 
-(defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (pointer-address gtk-id)))
+(defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (cffi:pointer-address gtk-id)))
   (when *gtk-objects*
     (let ((clos-widget (gethash hash-id *gtk-objects*)))
       (when (and must-find-p (not clos-widget))
@@ -115,7 +115,7 @@
 (defmacro def-gtk-event-handler (event)
   `(cffi:defcallback ,(intern (format nil "~a-HANDLER" event)) :int
      ((widget :pointer) (event :pointer) (data :pointer))
-     (bif (self (gtk-object-find widget))
+     (if-bind (self (gtk-object-find widget))
 	  (let ((cb (callback-recover self ,(intern (string event) :keyword))))
 	    (funcall cb self widget event data))
 	  (trc nil "Unknown widget from prior run. Clean up on errors" widget))))



From pdenno at common-lisp.net  Sun Feb 19 20:15:07 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:15:07 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060219201507.B4D0B2A01A@common-lisp.net>

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

Modified Files:
	gtk-core.lisp 
Log Message:
Use uffi package prefix

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/02/16 18:02:17	1.7
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-core.lisp	2006/02/19 20:15:07	1.8
@@ -47,7 +47,7 @@
   (gdk-threads-leave :void ())
   (gdk-flush :void ()))
 
-(def-union g-value-data
+(uffi:def-union g-value-data
   (v-int :int)
   (v-uint :unsigned-int)
   (v-long :long)
@@ -60,7 +60,7 @@
   (v-double :double)
   (v-pointer :pointer-void))
 
-(def-struct g-value
+(uffi:def-struct g-value
     (g-type (:array :int 16)))
 
 (defmacro with-g-value ((var) &body body)
@@ -72,7 +72,7 @@
     (unwind-protect
         (dotimes (n 16)
             (let* ((gv (cffi:mem-aref gva 'g-value 0))
-		   (ns (get-slot-pointer gv 'g-value 'g-type)))
+		   (ns (cffi:foreign-slot-value gv 'g-value 'g-type)))
 		(setf (cffi:mem-aref ns ':int n) 0))))
           (funcall fn gva)
       (cffi:foreign-free gva)))



From pdenno at common-lisp.net  Sun Feb 19 20:16:57 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:16:57 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060219201657.EE6292A01A@common-lisp.net>

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

Modified Files:
	gtk-ffi.asd 
Log Message:
Don't use utils.lisp (never was in CVS repository) don't use package :uffi

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/02/16 18:02:59	1.12
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.asd	2006/02/19 20:16:57	1.13
@@ -11,10 +11,9 @@
 
 (asdf:defsystem :gtk-ffi
   :name "gtk-ffi"
-  :depends-on (:cells :cffi :cffi-uffi-compat)
+  :depends-on (:cells :pod-utils :cffi :cffi-uffi-compat)
   :components
-  ((:file "utils")
-   (:file "gtk-ffi" :depends-on ("utils"))
+  ((:file "gtk-ffi")
    (:file "gtk-core" :depends-on ("gtk-ffi"))
    (:file "gtk-other" :depends-on ("gtk-ffi"))
    (:file "gtk-button" :depends-on ("gtk-ffi"))



From pdenno at common-lisp.net  Sun Feb 19 20:17:41 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:17:41 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060219201741.9CC7D2A01A@common-lisp.net>

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

Modified Files:
	gtk-ffi.lisp 
Log Message:
uffi --> cffi

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/16 21:55:32	1.18
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp	2006/02/19 20:17:41	1.19
@@ -16,11 +16,12 @@
  
 |#
 
-(defpackage :gtk-ffi (:use :common-lisp :pod :uffi)) ; pod remove uffi
+(defpackage :gtk-ffi (:use :common-lisp :pod))
 
 (in-package :gtk-ffi)
 
-;;; POD throw-away utility
+;;; POD throw-away utility to convert hello-c/uffi to cffi
+#+nil
 (defun gtk-lib2cffi (body)
   "Convert hello-c to uffi to cffi types. Swap order of arguments."
   (flet ((convert-type (type)
@@ -49,7 +50,6 @@
 
 (defconstant +c-null+ (cffi:null-pointer)) 
 (defvar *gtk-debug* nil)
-(defvar *zippy* "diagnostics")
 
 ;;; ==============  Define CFFI types, and their translations.... 
 (cffi:defctype :gtk-string :pointer :documentation "string type for cffi type translation")
@@ -73,15 +73,11 @@
 
 (defun int-slot-indexed (obj obj-type slot index)
   (declare (ignorable obj-type))
-  (deref-array
-   (get-slot-pointer obj obj-type slot)
-   '(:array :int) index))
+  (cffi:mem-aref (cffi:foreign-slot-value obj obj-type slot) :int  index))
 
 (defun (setf int-slot-indexed) (new-value obj obj-type slot index)
   (declare (ignorable obj-type))
-  (setf (deref-array
-         (get-slot-pointer obj obj-type slot)
-         '(:array :int) index)
+  (setf (cffi:mem-aref (cffi:foreign-slot-value obj obj-type slot) :int index)
     new-value))
 
 (cffi:define-foreign-library 'gobject
@@ -224,10 +220,10 @@
           `(defun ,(intern (string-upcase (format nil "make-~a" struct-name)))
              (&key ,@(loop for (name supplied nil) in slot-defs
                          collecting (list name nil supplied)))
-             (let ((,obj (allocate-foreign-object ',struct-name)))
+             (let ((,obj (uffi:allocate-foreign-object ',struct-name)))
                ,@(loop for (name supplied nil) in slot-defs
                      collecting `(when ,supplied
-                                   (setf (get-slot-value ,obj ',struct-name ',name) ,name)))
+                                   (setf (cffi:foreign-slot-value ,obj ',struct-name ',name) ,name)))
                ,obj)))
 
        ;; --- accessors ---
@@ -236,9 +232,9 @@
                            (accessor (intern (format nil "~a-~a" struct-name slot-name))))
                    `(progn
                       (defun ,accessor (self)
-                        (get-slot-value self ',struct-name ',slot-name))
+                        (cffi:foreign-slot-value self ',struct-name ',slot-name))
                       (defun (setf ,accessor) (new-value self)
-                        (setf (get-slot-value self ',struct-name ',slot-name)
+                        (setf (cffi:foreign-slot-value self ',struct-name ',slot-name)
                           new-value))))
            slot-defs))))
 
@@ -380,10 +376,10 @@
 
 (defmacro with-tree-iter ((iter-var) &body body)
   `(uffi:with-foreign-object (,iter-var 'gtk-tree-iter)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'stamp) 0)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data) +c-null+)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data2) +c-null+)
-     (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data3) +c-null+)
+     (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'stamp) 0)
+     (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data) +c-null+)
+     (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data2) +c-null+)
+     (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data3) +c-null+)
      , at body))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -421,14 +417,14 @@
 (defmacro deref-pointer-runtime-typed (ptr type)
   "Returns a object pointed"
   (declare (ignorable type))
-  `(deref-pointer ,ptr ,type))
+  `(uffi:deref-pointer ,ptr ,type))
 
 (defun cast (ptr type)
   (deref-pointer-runtime-typed ptr (ffi-to-uffi-type type)))
 
 (eval-when (compile load eval)
   (export '(uint c-pointer c-ptr-null c-array-ptr c-ptr c-string sint32 uint32 uint8 boolean
-             ulong int long single-float double-float otherwise *gtk-debug*
-             col-type-to-ffi-type deref-pointer-runtime-typed gtk-tree-iter)))
+	    ulong int long single-float double-float otherwise *gtk-debug* load-gtk-libs
+	    col-type-to-ffi-type deref-pointer-runtime-typed gtk-tree-iter +c-null+)))
 
 



From pdenno at common-lisp.net  Sun Feb 19 20:18:27 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:18:27 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/gtk-ffi
Message-ID: <20060219201827.E3F6F2A01A@common-lisp.net>

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

Modified Files:
	gtk-utilities.lisp 
Log Message:
uffi --> cffi

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/16 18:07:50	1.18
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/19 20:18:27	1.19
@@ -35,10 +35,10 @@
        (or destroy-data +c-null+)
        (if after 1 0)))))
 
-(uffi:def-function ("g_signal_connect_data" g_signal_connect_data)
-    ((instance :pointer-void) (detailed-signal :cstring)
-     (c-handler :pointer-void) (data :pointer-void)(destroy-data :pointer-void) (after :int))
-  :returning :unsigned-long)
+(cffi:defcfun ("g_signal_connect_data" g_signal_connect_data)
+              :unsigned-long
+  (instance :pointer) (detailed-signal :pointer) (c-handler :pointer) 
+  (data :pointer) (destroy-data :pointer) (after :int))
 
 (defun wrap-func (func-address) ;; vestigial. func would never be nil. i think.
   (or func-address 0))
@@ -62,17 +62,17 @@
   (typecase pointer
     (string pointer)
     (otherwise
-     (ukt:trc nil "get-gtk-string sees" pointer (type-of pointer))
-     #+allegro (convert-from-cstring pointer)
-     #+lispworks (convert-from-foreign-string pointer
+     (pod:trc nil "get-gtk-string sees" pointer (type-of pointer))
+     #+allegro (uffi:convert-from-cstring pointer)
+     #+lispworks (uffi:convert-from-foreign-string pointer
                    :null-terminated-p t)
      #-(or allegro lispworks)
-     (with-foreign-object (bytes-written :int)
+     (uffi:with-foreign-object (bytes-written :int)
        (g-locale-from-utf8 pointer -1 +c-null+ bytes-written +c-null+)))))
 
 (defun to-gtk-string (str)
   "!!!! remember to free returned str pointer"
-  (with-foreign-object (bytes-written :int)
+  (uffi:with-foreign-object (bytes-written :int)
     (g-locale-to-utf8 str -1 +c-null+ bytes-written +c-null+)))
 
 (defmacro with-gdk-threads (&rest body)
@@ -134,7 +134,7 @@
             (or str-ptr (and (eql type :date) (coerce data 'single-float)) data))
           (gtk-list-store-set-value lstore iter col value)
           (g-value-unset value)
-          (when str-ptr (free-cstring str-ptr)))))
+          (when str-ptr (uffi:free-cstring str-ptr)))))
 
 (defun gtk-list-store-set-items (store types-lst data-lst)
   (with-tree-iter (iter)
@@ -180,7 +180,7 @@
   "Returns the item at column-no if column-no [0,<num-columns-1>] or a
    a string like '(0 1 0)', which navigates to the selected item, if 
    column-no = num-columns. (See gtk-tree-store-set-kids)."
-  (with-foreign-object (item :pointer-void)
+  (uffi:with-foreign-object (item :pointer-void)
     (gtk-tree-model-get model iter column-no item -1)
   (case cell-type
     (:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring)))
@@ -198,31 +198,31 @@
 (progn
   (defun alloc-col-type-buffer (col-type)
     (ecase col-type
-      ((:string :icon) (allocate-foreign-object '(:array :cstring) 1))
-      (:boolean (allocate-foreign-object '(:array :unsigned-byte) 1)) ;;guess
-      (:date (allocate-foreign-object '(:array :float) 1))
-      (:int (allocate-foreign-object '(:array :int) 1))
-      (:long (allocate-foreign-object '(:array :long) 1))
-      (:float (allocate-foreign-object '(:array :float) 1))
-      (:double (allocate-foreign-object '(:array :double) 1))))
+      ((:string :icon) (uffi:allocate-foreign-object '(:array :cstring) 1))
+      (:boolean (uffi:allocate-foreign-object '(:array :unsigned-byte) 1)) ;;guess
+      (:date (uffi:allocate-foreign-object '(:array :float) 1))
+      (:int (uffi:allocate-foreign-object '(:array :int) 1))
+      (:long (uffi:allocate-foreign-object '(:array :long) 1))
+      (:float (uffi:allocate-foreign-object '(:array :float) 1))
+      (:double (uffi:allocate-foreign-object '(:array :double) 1))))
   
   (defun deref-col-type-buffer (col-type buffer)
     (ecase col-type
       ((:string :icon)
        (get-gtk-string
-        (make-pointer (deref-array buffer '(:array :cstring) 0) :cstring)))
-      (:boolean (not (zerop (deref-array buffer '(:array :unsigned-byte) 0)))) ;;guess
-      (:date (deref-array buffer '(:array :float) 0))
-      (:int (deref-array buffer '(:array :int) 0))
-      (:long (deref-array buffer '(:array :long) 0))
-      (:float (deref-array buffer '(:array :float) 0))
-      (:double (deref-array buffer '(:array :double) 0)))))
+        (cffi:make-pointer (cffi:mem-aref buffer :pointer 0) :cstring)))
+      (:boolean (not (zerop (cffi:mem-aref buffer :unsigned-char 0))))
+      (:date (cffi:mem-aref buffer :FLOAT 0))
+      (:int (cffi:mem-aref buffer :int 0))
+      (:long (cffi:mem-aref buffer :long 0))
+      (:float (cffi:mem-aref buffer :float 0))
+      (:double (cffi:mem-aref buffer :double 0)))))
 
 (defun gtk-tree-view-render-cell (col col-type cell-attrib-f) 
-  (ukt:trc nil "gtv-render-cell> creating callback" col col-type cell-attrib-f)
+  (pod:trc nil "gtv-render-cell> creating callback" col col-type cell-attrib-f)
   (lambda (tree-column cell-renderer model iter data)
     (DECLARE (ignorable tree-column data))
-    (ukt:trc nil "gtv-render-cell (callback)> entry"
+    (pod:trc nil "gtv-render-cell (callback)> entry"
       tree-column cell-renderer model iter data)
     (let ((return-buffer (cffi:foreign-alloc :int :count 16)))
       (gtk-tree-model-get model iter col
@@ -233,11 +233,11 @@
              (ret$ (when (find col-type '(:string :icon))
 		     returned-value))
              (item-value (cond 
-                          (ret$ (convert-from-cstring ret$))
+                          (ret$ (uffi:convert-from-cstring ret$))
                           ((eq col-type :boolean)
                            (not (zerop returned-value)))
                           (t returned-value))))
-        (ukt:trc nil "gtv-render-cell (callback)>> rendering value"
+        (pod:trc nil "gtv-render-cell (callback)>> rendering value"
           col col-type ret$ item-value)
 
         (apply #'gtk-object-set-property cell-renderer 
@@ -263,9 +263,9 @@
 
 (defun gtk-file-chooser-get-filenames-strs (file-chooser)
   (let ((glist (gtk-file-chooser-get-filenames file-chooser)))
-    (loop for lst-address = glist then (get-slot-value lst-address 'gslist 'next)
+    (loop for lst-address = glist then (cffi:foreign-slot-value lst-address 'gslist 'next)
         while (and lst-address (not (zerop lst-address)))
-        collect (get-slot-value lst-address 'gslist 'data)
+        collect (cffi:foreign-slot-value lst-address 'gslist 'data)
         finally (g-slist-free glist))))
 
 (eval-when (compile load eval)



From pdenno at common-lisp.net  Sun Feb 19 20:19:13 2006
From: pdenno at common-lisp.net (pdenno)
Date: Sun, 19 Feb 2006 14:19:13 -0600 (CST)
Subject: [cells-gtk-cvs] CVS root/cells-gtk/test-gtk
Message-ID: <20060219201913.DC4B42A01A@common-lisp.net>

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp:/tmp/cvs-serv16208/root/cells-gtk/test-gtk

Modified Files:
	test-gtk.lisp 
Log Message:
don't use package :ukt, use package :pod

--- /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-gtk.lisp	2006/02/16 18:20:53	1.12
+++ /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk/test-gtk.lisp	2006/02/19 20:19:13	1.13
@@ -1,5 +1,5 @@
 (defpackage :test-gtk
-  (:use :common-lisp :utils-kt :pod :cells :gtk-ffi :cells-gtk))
+  (:use :common-lisp :pod :cells :gtk-ffi :cells-gtk))
 
 (in-package :test-gtk)