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