[graphic-forms-cvs] r476 - in trunk: . docs/website src/tests/uitoolkit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Aug 21 04:45:24 UTC 2007
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,
More information about the Graphic-forms-cvs
mailing list