[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