[graphic-forms-cvs] r26 - in trunk: . src/tests/uitoolkit
junrue at common-lisp.net
junrue at common-lisp.net
Sat Mar 4 17:23:23 UTC 2006
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))
More information about the Graphic-forms-cvs
mailing list