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

phildebrandt phildebrandt at common-lisp.net
Sun Apr 20 13:05:03 UTC 2008


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

Modified Files:
	test-buttons.lisp test-drawing.lisp 
Log Message:
now runs with the cells-store inside


--- /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-buttons.lisp	2008/04/16 14:41:30	1.3
+++ /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-buttons.lisp	2008/04/20 13:05:03	1.4
@@ -4,42 +4,45 @@
   ((nclics :accessor nclics :initform (c-in 0)))
   (:default-initargs
       :kids (c? (the-kids
-                 (mk-label :text (c? (format nil "Toggled button active = ~a" 
-                                       (with-widget (w :toggled-button)
-					 (trc "calculating toggled button" w (value w))
-					 (value w)))))
+                 (mk-label :text (c? (trc "### executing toggled button rule")
+				     (format nil "Toggled button active = ~a"
+					     (with-widget (w :toggled-button)
+					       (trc "   FOUND WIDGET" w (value w))
+					       (value w)))))
                  (mk-hseparator)
                  (mk-label :text (c? (format nil "Check button checked = ~a" 
-                                       (widget-value :check-button))))
+					     (widget-value :check-button))))
                  (mk-hseparator)
-                 (mk-label :text (c? (format nil "Radio button selected = ~a" 
-                                       (with-widget (w :radio-group)
-					 (value w)))))
+                 (mk-label :text (c? (trc "### executing radio button rule")
+				     (format nil "Radio button selected = ~a" 
+					     (with-widget (w :radio-group)
+					       (trc "   FOUND WIDGET")
+					       (value w)))))
                  (mk-hseparator)
                  (mk-label :text (c? (format nil "Button clicked ~a times" 
-                                       (nclics (upper self test-buttons))))
-                   :selectable t)
+					     (nclics (upper self test-buttons))))
+			   :selectable t)
                  (mk-hseparator)
                  
                  (mk-hbox
                   :kids (c? (the-kids
                              (mk-button :stock :apply
-                               :tooltip "Click ....."
-                               :on-clicked (callback (widget event data)
-                                             (incf (nclics (upper self test-buttons)))))
+					:tooltip "Click ....."
+					:on-clicked (callback (widget event data)
+						      (incf (nclics (upper self test-buttons)))))
                              (mk-button :label "Continuable error"
-                               :on-clicked (callback (widget event data)
-                                             (trc "issuing continuable error" widget event)
-                                             (error 'gtk-continuable-error :text "Oops!")))
+					:on-clicked (callback (widget event data)
+						      (trc "issuing continuable error" widget event)
+						      (error 'gtk-continuable-error :text "Oops!")))
 			     (mk-button :label "Lisp error (Div 0)"
-				:on-clicked (callback (widget event data)
+					:on-clicked (callback (widget event data)
 						      (print (/ 3 0))))
                              (mk-toggle-button :md-name :toggled-button
-                               :markup (c? (with-markup (:foreground (if (value self) :red :blue))
-                                             "_Toggled Button")))
+					       :markup (c? (with-markup (:foreground (if (value self) :red :blue))
+							     "_Toggled Button")))
                              (mk-check-button :md-name :check-button				      
-                               :markup (with-markup (:foreground :green)
-                                         "_Check Button")))))
+					      :markup (with-markup (:foreground :green)
+							"_Check Button")))))
                  (mk-hbox
                   :md-name :radio-group
                   :kids (kids-list?
@@ -48,4 +51,11 @@
 			 (mk-radio-button :md-name :radio-2
 					  :label "Radio 2" :init t)
 			 (mk-radio-button :md-name :radio-3
-					  :label "Radio 3")))))))
+					  :label "Radio 3")))
+		 (mk-hbox
+		  :kids (kids-list?
+			 (mk-label :text (c? (trc "### executing toggled button rule 2")
+					     (format nil "Toggled button active = ~a"
+						     (with-widget (w :toggled-button)
+						       (trc "   FOUND WIDGET 2" w (value w))
+						       (value w)))))))))))
--- /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-drawing.lisp	2008/04/14 16:43:48	1.2
+++ /project/cells/cvsroot/cells-gtk3/cells-gtk/test-gtk/test-drawing.lisp	2008/04/20 13:05:03	1.3
@@ -61,7 +61,7 @@
 						      (col1 (random-color))
 						      (col2 (random-color)))
 						 (trcx "rect" p1 p2 col1 col2)
-						 (mk-primitive (fm-other :draw) :rectangle
+						 (mk-primitive (find-widget :draw) :rectangle
 							       :p1 (c-in p1)
 							       :p2 (c-in p2)
 							       :rgb (rgb? col1)
@@ -76,7 +76,7 @@
 						      (radius (rnd 10 40))
 						      (col1 (random-color))
 						      (col2 (random-color)))
-						 (mk-primitive (fm-other :draw) :arc
+						 (mk-primitive (find-widget :draw) :arc
 							       :p (c-in p)
 							       :radius (c-in radius)
 							       :rgb (rgb? col1)
@@ -99,7 +99,7 @@
 	      'cairo-drawing-area
 	      :md-name :draw-sun :expand t :fill t :width 500 :height 500
 	      :fm-parent *parent*
-	      :canvas (c? (let ((draw self))
+	      :canvas (c?n (let ((draw self))
 			    (declare (ignorable draw))
 			    (list
 			     (make-instance




More information about the Cells-cvs mailing list