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 ,@body))) \ No newline at end of file + `(c? (the-kids ,@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"