Author: junrue Date: Mon Feb 13 21:15:34 2006 New Revision: 9

Modified: trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/hello-world.lisp trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp Log: invoke default message loop on behalf of application code

Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Mon Feb 13 21:15:34 2006 @@ -205,8 +205,7 @@ ((:menu "&Help" :dispatcher ,echo-md) (:menuitem "&About" :dispatcher ,echo-md :image "foobar.bmp"))))) (setf (gfw:menu-bar *event-tester-window*) menubar) - (gfw:show *event-tester-window*) - (gfw:run-default-message-loop))) + (gfw:show *event-tester-window*)))

(defun run-event-tester () (gfw:startup "Event Tester" #'run-event-tester-internal))

Modified: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- trunk/src/tests/uitoolkit/hello-world.lisp (original) +++ trunk/src/tests/uitoolkit/hello-world.lisp Mon Feb 13 21:15:34 2006 @@ -68,8 +68,7 @@ (setf menubar (gfw:defmenusystem `(((:menu "&File") (:menuitem "E&xit" :dispatcher ,md))))) (setf (gfw:menu-bar *hellowin*) menubar) - (gfw:show *hellowin*) - (gfw:run-default-message-loop))) + (gfw:show *hellowin*)))

(defun run-hello-world () (gfw:startup "Hello World" #'run-hello-world-internal))

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Mon Feb 13 21:15:34 2006 @@ -139,8 +139,7 @@ (add-layout-tester-widget 'gfw:button :push-button) (add-layout-tester-widget 'gfw:button :push-button) (add-layout-tester-widget 'gfw:button :push-button) - (gfw:show *layout-tester-win*) - (gfw:run-default-message-loop))) + (gfw:show *layout-tester-win*)))

(defun run-layout-tester () (gfw:startup "Layout Tester" #'run-layout-tester-internal))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Mon Feb 13 21:15:34 2006 @@ -36,12 +36,17 @@ #+clisp (defun startup (thread-name start-fn) (declare (ignore thread-name)) (setf *the-thread-context* (make-instance 'thread-context)) - (funcall start-fn)) + (funcall start-fn) + (run-default-message-loop))

#+lispworks (defun startup (thread-name start-fn) (when (null (mp:list-all-processes)) (mp:initialize-multiprocessing)) - (mp:process-run-function thread-name nil start-fn)) + (mp:process-run-function thread-name + nil + #'(lambda () (progn + (funcall start-fn) + (run-default-message-loop)))))

(defun shutdown (exit-code) (gfs::post-quit-message exit-code))