[cells-cvs] CVS cells-gtk

[phildebrandt]

Update of /project/cells/cvsroot/cells-gtk
In directory clnet:/tmp/cvs-serv6810

Modified Files:
	cells-gtk.asd cells3-porting-notes.lisp dialogs.lisp 
	widgets.lisp 
Log Message:
merging in ken's and peter's changes from Jan 29th


--- /project/cells/cvsroot/cells-gtk/cells-gtk.asd	2008/01/28 23:59:22	1.1
+++ /project/cells/cvsroot/cells-gtk/cells-gtk.asd	2008/01/30 14:21:01	1.2
@@ -8,6 +8,7 @@
   ((:file "packages")   
    (:file "conditions")
    (:file "compat")
+   (:file "cells3-porting-notes" :depends-on ("packages"))
    (:file "widgets" :depends-on ("conditions"))
    (:file "layout" :depends-on ("widgets"))
    (:file "display" :depends-on ("widgets"))
--- /project/cells/cvsroot/cells-gtk/cells3-porting-notes.lisp	2008/01/28 23:59:22	1.1
+++ /project/cells/cvsroot/cells-gtk/cells3-porting-notes.lisp	2008/01/30 14:21:01	1.2
@@ -20,12 +20,15 @@
 
 (in-package :cells-gtk)
 
-(export '(make-be kids-list?))
 
 (defun make-be (class &rest args)
-  (md-awaken (apply 'make-instance class args)))
+  (let ((x (apply 'make-instance class args)))
+   (md-awaken x)
+   x))
 
-(defun to-be (x) (md-awaken x))
+(defun to-be (x) (md-awaken x) x)
 
 (defmacro kids-list? (&rest body)
-  `(c? (the-kids , at body)))
\ No newline at end of file
+  `(c? (the-kids , at body)))
+
+(export '(make-be to-be kids-list?))
\ No newline at end of file
--- /project/cells/cvsroot/cells-gtk/dialogs.lisp	2008/01/28 23:59:22	1.1
+++ /project/cells/cvsroot/cells-gtk/dialogs.lisp	2008/01/30 14:21:01	1.2
@@ -46,6 +46,7 @@
 		      (message self))))
 
 (defmethod md-awaken :after ((self message-dialog))
+  (print 'md-awaken-after)
   (let ((response (gtk-dialog-run (id self))))
     (setf (value self)
 	  (case response
@@ -54,12 +55,14 @@
 	    (-7 :close)
 	    (-8 :yes)
 	    (-9 :no))))
-  (gtk-widget-destroy (id self))
-  (gtk-object-forget (id self) self)
   (with-slots (content-area) self
     (when content-area 
       (setf (value self) (value content-area))
-      (gtk-object-forget (id content-area) content-area))))
+      (print (value content-area))
+      (gtk-object-forget (id content-area) content-area)))
+  (gtk-widget-destroy (id self))
+  (gtk-object-forget (id self) self)
+  (print 'done))
 	   
 (defun show-message (text &rest inits)
   (let ((message-widget (to-be (apply #'mk-message-dialog :message text inits))))
--- /project/cells/cvsroot/cells-gtk/widgets.lisp	2008/01/28 23:59:24	1.1
+++ /project/cells/cvsroot/cells-gtk/widgets.lisp	2008/01/30 14:21:01	1.2
@@ -20,7 +20,7 @@
 
 
 (defmodel gtk-object (family)
-  ((container :cell nil :initarg :container :accessor container)
+  ((container :cell nil :initarg :container :accessor container :initform nil)
    (def-gtk-class-name :accessor def-gtk-class-name :initarg :def-gtk-class-name :initform nil)
    (new-function-name :accessor new-function-name :initarg :new-function-name 
      :initform (c? (intern (format nil "GTK-~a-NEW~a"