[cells-cvs] CVS cells-gtk/test-gtk

phildebrandt phildebrandt at common-lisp.net
Wed Jan 30 14:21:02 UTC 2008


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

Modified Files:
	test-dialogs.lisp test-gtk.lisp 
Log Message:
merging in ken's and peter's changes from Jan 29th


--- /project/cells/cvsroot/cells-gtk/test-gtk/test-dialogs.lisp	2008/01/29 00:00:34	1.1
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-dialogs.lisp	2008/01/30 14:21:02	1.2
@@ -35,16 +35,18 @@
                        (mk-button :label "Query for text"
                          :on-clicked 
                          (callback (w e d) 
-                           (let ((dialog
-                                  (to-be
-                                   (mk-message-dialog
-                                    :md-name :rule-name-dialog
-                                    :message "Type something:"
-                                    :title "My Title"
-                                    :message-type :question
-                                    :buttons-type :ok-cancel
-                                    :content-area (mk-entry :auto-aupdate t)))))
-                             (setf (text (fm^ :message-response)) (value dialog))))))
+                           (with-integrity (:change 'q4text)
+			     (let ((dialog
+				   (to-be (mk-message-dialog
+				     :md-name :rule-name-dialog
+				     :message "Type something:"
+				     :title "My Title"
+				     :message-type :question
+				     :buttons-type :ok-cancel
+				     :content-area (mk-entry :auto-aupdate t)))))
+			      (print 'back)
+			      (print (list 'value-dialog  (value dialog)))
+			      (setf (text (fm^ :message-response)) (value dialog)))))))
                       (loop for message-type in '(:info :warning :question :error) collect
                             (make-kid 'test-message :message-type message-type)))))
              (mk-label :md-name :message-response)
--- /project/cells/cvsroot/cells-gtk/test-gtk/test-gtk.lisp	2008/01/29 00:00:34	1.1
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-gtk.lisp	2008/01/30 14:21:02	1.2
@@ -41,7 +41,7 @@
     :kids (c? (the-kids
                (let ((tabs '("Buttons"
                              "Display"
-                             "Layout"
+                              "Layout"
                              "Menus"
                              "Textview"
                              "Dialogs"
@@ -65,7 +65,7 @@
 
 
 (defun gtk-demo (&optional dbg)
-  (ukt:test-prep)
+  #-iamnotkenny (ukt:test-prep)
   (cells-gtk-init)
   (cells-gtk:start-app 'test-gtk::test-gtk :debug dbg))
 




More information about the Cells-cvs mailing list