Author: junrue Date: Sat Mar 4 12:23:22 2006 New Revision: 26
Modified: trunk/graphic-forms-tests.asd trunk/src/tests/uitoolkit/layout-tester.lisp Log: layout tester up-to-date with new menu system definition
Modified: trunk/graphic-forms-tests.asd ============================================================================== --- trunk/graphic-forms-tests.asd (original) +++ trunk/graphic-forms-tests.asd Sat Mar 4 12:23:22 2006 @@ -50,8 +50,5 @@ ((:module "uitoolkit" :components ((:file "hello-world") - (:file "event-tester"))))))))) -#| - (:file "hello-world"))))))))) - (:file "layout-tester")) -|# + (:file "event-tester") + (:file "layout-tester")))))))))
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Sat Mar 4 12:23:22 2006 @@ -123,15 +123,11 @@ (gfw:clear-all menu) (gfw:with-children (*layout-tester-win* kids) (loop for k in kids - do (let ((it (make-instance 'gfw:menu-item))) - (gfw:append-item menu it) + do (let ((it (gfw::append-item menu (gfw:text k) nil nil))) (unless (null (sub-disp-class-of d)) (setf (gfw:dispatcher it) (make-instance (sub-disp-class-of d)))) - (setf (gfw:text it) (gfw:text k)) (unless (null (check-test-fn d)) - (if (funcall (check-test-fn d) k) - (gfw::check it) - (gfw::uncheck it))))))) + (gfw:check it (funcall (check-test-fn d) k)))))))
(defclass remove-child-dispatcher (gfw:event-dispatcher) ())
@@ -158,9 +154,7 @@ do (if (string= (gfw:text k) text) (setf victim k)))) (unless (null victim) - (if (gfw:visible-p victim) - (gfw:hide victim) - (gfw:show victim)) + (gfw:show victim (not (gfw:visible-p victim))) (gfw:layout *layout-tester-win*))))
(defclass flow-modifier-menu-dispatcher (gfw:event-dispatcher) ()) @@ -169,34 +163,28 @@ (declare (ignore time)) (gfw:clear-all menu) (let ((it nil) - (margin-menu (gfw:defmenusystem `(((:menu "Top") - (:menuitem "Decrease") - (:menuitem "Increase")) - ((:menu "Left") - (:menuitem "Decrease") - (:menuitem "Increase")) - ((:menu "Right") - (:menuitem "Decrease") - (:menuitem "Increase")) - ((:menu "Bottom") - (:menuitem "Decrease") - (:menuitem "Increase"))))) - (orient-menu (gfw:defmenusystem `(((:menu "") - (:menuitem "Horizontal") - (:menuitem "Vertical"))))) - (spacing-menu (gfw:defmenusystem `(((:menu "") - (:menuitem "Decrease") - (:menuitem "Increase")))))) + (margin-menu (gfw:defmenusystem ((:item "Top" + :submenu ((:item "Decrease") + (:item "Increase"))) + (:item "Left" + :submenu ((:item "Decrease") + (:item "Increase"))) + (:item "Right" + :submenu ((:item "Decrease") + (:item "Increase"))) + (:item "Bottom" + :submenu ((:item "Decrease") + (:item "Increase")))))) + (orient-menu (gfw:defmenusystem ((:item "Horizontal") + (:item "Vertical")))) + (spacing-menu (gfw:defmenusystem ((:item "Decrease") + (:item "Increase"))))) (gfw:append-submenu menu "Margin" margin-menu) (gfw:append-submenu menu "Orientation" orient-menu) (gfw:append-submenu menu "Spacing" spacing-menu) - (setf it (make-instance 'gfw:menu-item)) - (gfw:append-item menu it) - (setf (gfw:text it) "Fill") - (gfw:check it) - (setf it (make-instance 'gfw:menu-item)) - (gfw:append-item menu it) - (setf (gfw:text it) "Wrap"))) + (setf it (gfw:append-item menu "Fill" nil nil)) + (gfw:check it t) + (gfw:append-item menu "Wrap" nil nil)))
(defclass layout-tester-exit-dispatcher (gfw:event-dispatcher) ())
@@ -219,24 +207,27 @@ (setf *layout-tester-win* (make-instance 'gfw:window :dispatcher (make-instance 'layout-tester-events) :layout-manager (make-instance 'gfw:flow-layout))) (gfw:realize *layout-tester-win* nil :style-workspace) - (setf menubar (gfw:defmenusystem `(((:menu "&File") - (:menuitem "E&xit" :dispatcher ,exit-disp)) - ((:menu "&Children") - (:menuitem :submenu ((:menu "Add") - (:menuitem "Button" :dispatcher ,add-btn-disp) - (:menuitem "Label" :dispatcher ,add-text-label-disp))) - (:menuitem :submenu ((:menu "Remove" :dispatcher ,rem-menu-disp))) - (:menuitem :submenu ((:menu "Set Visibility" :dispatcher ,vis-menu-disp)))) - ((:menu "&Window") - (:menuitem :submenu ((:menu "Modify Layout" :dispatcher ,mod-layout-menu-disp))) - (:menuitem :submenu ((:menu "Select Layout") - (:menuitem "Flow"))) - (:menuitem "Pack" :dispatcher ,pack-disp))))) + (setf menubar (gfw:defmenusystem ((:item "&File" + :submenu ((:item "E&xit" :dispatcher exit-disp))) + (:item "&Children" + :submenu ((:item "Add" + :submenu ((:item "Button" :dispatcher add-btn-disp) + (:item "Label" :dispatcher add-text-label-disp))) + (:item "Remove" :dispatcher rem-menu-disp + :submenu ((:item ""))) + (:item "Visible" :dispatcher vis-menu-disp + :submenu ((:item ""))))) + (:item "&Window" + :submenu ((:item "Modify Layout" :dispatcher mod-layout-menu-disp + :submenu ((:item ""))) + (:item "Select Layout" + :submenu ((:item "Flow"))) + (:item "Pack" :dispatcher pack-disp)))))) (setf (gfw:menu-bar *layout-tester-win*) menubar) (dotimes (i 3) (add-layout-tester-widget 'gfw:button :push-button)) (gfw:pack *layout-tester-win*) - (gfw:show *layout-tester-win*))) + (gfw:show *layout-tester-win* t)))
(defun run-layout-tester () (gfw:startup "Layout Tester" #'run-layout-tester-internal))