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,