Author: junrue Date: Mon Jul 9 00:17:21 2007 New Revision: 469
Modified: trunk/src/tests/uitoolkit/event-tester.lisp Log: revised event-tester menu creation to test GFW:DEFMENU2 and GFW:MAKE-MENU
Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Mon Jul 9 00:17:21 2007 @@ -289,22 +289,24 @@ (setf *event-counter* 0) (let ((echo-md (make-instance 'event-tester-echo-dispatcher)) (exit-md (make-instance 'event-tester-exit-dispatcher)) - (menubar nil)) + (menu-factory nil)) (setf *event-tester-window* (make-instance 'gfw:top-level :dispatcher (make-instance 'event-tester-window-events) :style '(:workspace :horizontal-scrollbar :vertical-scrollbar))) (initialize-scrollbars) - (setf menubar (gfw:defmenu ((:item "&File" :callback #'manage-file-menu - :submenu ((:item "Timer" :callback #'manage-timer) - (:item "" :separator) - (:item "E&xit" :dispatcher exit-md))) - (:item "&Test Menu" :dispatcher echo-md - :submenu ((:item "&Checked Item" :checked :dispatcher echo-md) - (:item "&Submenu" :dispatcher echo-md - :submenu ((:item "&Item A" :dispatcher echo-md :disabled) - (:item "&Item B" :dispatcher echo-md))))) - (:item "&Help" :dispatcher echo-md - :submenu ((:item "&About" :dispatcher echo-md)))))) - (setf (gfw:menu-bar *event-tester-window*) menubar) + (setf menu-factory + (gfw:defmenu2 :name 'event-tester-menu + :menu ((:item "&File" :callback #'manage-file-menu + :submenu ((:item "Timer" :callback #'manage-timer) + (:item "" :separator) + (:item "E&xit" :dispatcher exit-md))) + (:item "&Test Menu" :dispatcher echo-md + :submenu ((:item "&Checked Item" :checked :dispatcher echo-md) + (:item "&Submenu" :dispatcher echo-md + :submenu ((:item "&Item A" :dispatcher echo-md :disabled) + (:item "&Item B" :dispatcher echo-md))))) + (:item "&Help" :dispatcher echo-md + :submenu ((:item "&About" :dispatcher echo-md)))))) + (setf (gfw:menu-bar *event-tester-window*) (gfw:make-menu 'event-tester-menu)) (setf (gfw:image *event-tester-window*) (make-instance 'gfg:icon-bundle :file (merge-pathnames "default.ico"))) (gfw:show *event-tester-window* t)))