Author: junrue Date: Tue Aug 21 00:45:23 2007 New Revision: 476 Modified: trunk/NEWS.txt trunk/README.txt trunk/docs/website/index.html trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/widgets/dialog.lisp Log: applied patch 1748354 submitted by Leon van Dyk, and enabled a simple test case by reusing the dialog definition from the windlg test program Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Tue Aug 21 00:45:23 2007 @@ -5,6 +5,12 @@ . Latest CFFI is required to take advantage of built-in support for the stdcall calling convention. +. Integrated patch submitted by Leon van Dyk that enables dialog-only + applications. The GFT::STANDALONE-DIALOG function demonstrates this + feature, but NOTE that when this is invoked from SLIME, an old problem + reappears where the dialog is not initially visible; however, the same + demo run directly from the REPL works OK. + . Ported the library to Allegro CL 8.0. . Upgraded to LispWorks 5.0.1 (note: 4.4.6 is no longer supported) Modified: trunk/README.txt ============================================================================== --- trunk/README.txt (original) +++ trunk/README.txt Tue Aug 21 00:45:23 2007 @@ -74,11 +74,12 @@ the correct width. 5. If a Graphic-Forms application is launched from within SLIME with - SBCL as the backend (which is currently single-threaded on Win32), - further SLIME commands will be 'pipelined' until the Graphic-Forms - main message loop exits. If/when SBCL gains multi-threading support - on Win32, then the Graphic-Forms library code will be updated to - launch a separate thread, as is currently done for Allegro and LispWorks. + CLISP or SBCL as the backend (both of which are single-threaded on + Win32), further SLIME commands will be 'pipelined' until the + Graphic-Forms main message loop exits. If/when these implementations + gain multi-threading support on Win32, then the Graphic-Forms library + code will be updated to launch a separate thread, as is currently done + for Allegro and LispWorks. How To Configure and Build Modified: trunk/docs/website/index.html ============================================================================== --- trunk/docs/website/index.html (original) +++ trunk/docs/website/index.html Tue Aug 21 00:45:23 2007 @@ -47,7 +47,7 @@ <p>The supported Lisp implementations are: <ul> - <li><a href="http://franz.com/">Allegro CL 8.0</a> or later</li> + <li><a href="http://franz.com/">Allegro CL 8.0</a></li> <li><a href="http://clisp.cons.org/">CLISP 2.40</a> or later</li> <li><a href="http://www.lispworks.com/">LispWorks 5.0.1</a></li> <li><a href="http://www.sbcl.org/">SBCL 1.0.5</a> or later</li> Modified: trunk/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Tue Aug 21 00:45:23 2007 @@ -218,6 +218,7 @@ (format nil "~d" (gfw:thumb-position thing))) (defun populate-slider-test-panel () + (setf (gfw:text *widget-tester-win*) "Widget Tester (Sliders)") (let* ((layout1 (make-instance 'gfw:flow-layout :style '(:vertical) :spacing 4)) (layout2 (make-instance 'gfw:flow-layout :style '(:horizontal) :margins 4 :spacing 4)) (layout3 (make-instance 'gfw:flow-layout :style '(:horizontal) :margins 4 :spacing 4)) @@ -268,6 +269,7 @@ outer-panel)) (defun populate-progress-test-panel () + (setf (gfw:text *widget-tester-win*) "Widget Tester (Progress Bar)") (let* ((layout1 (make-instance 'gfw:border-layout :margins 4 :spacing 4)) (layout2 (make-instance 'gfw:flow-layout :margins 4)) (outer-panel (make-instance 'tester-panel :parent *widget-tester-win* Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Tue Aug 21 00:45:23 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; windlg.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -138,7 +138,10 @@ (defmethod gfw:event-close ((disp dialog-events) (dlg gfw:dialog)) (call-next-method) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) (defclass edit-control-events (gfw:event-dispatcher) ()) @@ -154,8 +157,8 @@ (defmethod gfw:event-modify ((disp edit-control-events) (ctrl gfw:edit)) (format t "modified: ~a...~%" (truncate-text (gfw:text ctrl)))) -(defun open-dlg (title style) - (let* ((dlg (make-instance 'gfw:dialog :owner *main-win* +(defun open-dlg (title style parent) + (let* ((dlg (make-instance 'gfw:dialog :owner parent :dispatcher (make-instance 'dialog-events) :layout (make-instance 'gfw:flow-layout :margins 8 @@ -208,14 +211,20 @@ (ok-btn (make-instance 'gfw:button :callback (lambda (disp btn) (declare (ignore disp btn)) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) :style '(:default-button) :text "OK" :parent btn-panel)) (cancel-btn (make-instance 'gfw:button :callback (lambda (disp btn) (declare (ignore disp btn)) - (gfs:dispose dlg)) + (let ((ownerp (gfw:owner dlg))) + (gfs:dispose dlg) + (unless ownerp + (gfw:shutdown 0)))) :style '(:cancel-button) :text "Cancel" :parent btn-panel))) @@ -224,17 +233,18 @@ (setf (gfw:text name-edit) "" (gfw:text pw-edit) "" (gfw:text desc-edit) "") - (gfw:center-on-owner dlg) + (if parent + (gfw:center-on-owner dlg)) (gfw:show dlg t) dlg)) (defun open-modal-dlg (disp item) (declare (ignore disp item)) - (open-dlg "Modal" '(:owner-modal))) + (open-dlg "Modal" '(:owner-modal) *main-win*)) (defun open-modeless-dlg (disp item) (declare (ignore disp item)) - (open-dlg "Modeless" '(:modeless))) + (open-dlg "Modeless" '(:modeless) *main-win*)) (defun windlg-internal () (let ((menubar nil)) @@ -260,3 +270,9 @@ (defun windlg () (gfw:startup "Window/Dialog Tester" #'windlg-internal)) + +(defun standalone-dialog-internal () + (open-dlg "Standalone Dialog" '(:modeless) nil)) + +(defun standalone-dialog () + (gfw:startup "Standalone Dialog Test" #'standalone-dialog-internal)) Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Tue Aug 21 00:45:23 2007 @@ -200,7 +200,7 @@ ;; owner of the dialog; it would cause the desktop to become ;; disabled. ;; - (if (cffi:pointer-eq (gfs:handle owner) (gfs::get-desktop-window)) + (if (and owner (cffi:pointer-eq (gfs:handle owner) (gfs::get-desktop-window))) (setf owner nil)) (push :keyboard-navigation (style-of self)) ;; FIXME: check if owner is actually a top-level or dialog, and if not,