[cells-gtk-cvs] CVS update: root/cells-gtk/test-gtk/test-dialogs.lisp

[Peter Denno]

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

Modified Files:
	test-dialogs.lisp 
Log Message:
Demonstrate dialog with text entry area
Date: Sun Feb 27 04:17:29 2005
Author: pdenno

Index: root/cells-gtk/test-gtk/test-dialogs.lisp
diff -u root/cells-gtk/test-gtk/test-dialogs.lisp:1.1 root/cells-gtk/test-gtk/test-dialogs.lisp:1.2
--- root/cells-gtk/test-gtk/test-dialogs.lisp:1.1	Fri Nov 19 00:40:14 2004
+++ root/cells-gtk/test-gtk/test-dialogs.lisp	Sun Feb 27 04:17:28 2005
@@ -26,9 +26,27 @@
   (:default-initargs
       :kids (list
 	     (mk-hbox
-	      :kids (loop for message-type in '(:info :warning :question :error) collect
-		     (make-instance 'test-message :message-type message-type)))
-	     (mk-label :md-name :message-response)
+	      :kids 
+              (append
+               #-libcellsgtk nil
+               #+libcellsgtk 
+               (list 
+                (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)) (md-value dialog))))))
+               (loop for message-type in '(:info :warning :question :error) collect
+                    (make-instance 'test-message :message-type message-type))))
+             (mk-label :md-name :message-response)
 	     (mk-hbox
 	      :kids (cons
 		     (mk-check-button :md-name :select-multiple-files