[snow-cvs] r27 - in trunk/src/lisp/snow: . swing

Alessio Stalla astalla at common-lisp.net
Thu Nov 26 22:20:34 UTC 2009


Author: astalla
Date: Thu Nov 26 17:20:33 2009
New Revision: 27

Log:
Fixed dialogs to be made visible only after the body has been evaluated, to
get modality right.


Modified:
   trunk/src/lisp/snow/snow.lisp
   trunk/src/lisp/snow/swing/swing.lisp

Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp	(original)
+++ trunk/src/lisp/snow/snow.lisp	Thu Nov 26 17:20:33 2009
@@ -154,7 +154,7 @@
 	  self))
      (setf (get ',name 'widget-p) t)))
 
-;Experimental - not working right now
+;;Experimental - not working right now
 (defmacro define-widget-function (name arglist constructor &body body)
   `(progn
      (defun ,name (, at arglist)
@@ -276,8 +276,25 @@
 (definterface make-dialog *gui-backend*
   (&key parent title modal-p visible-p &allow-other-keys))
 
+(define-widget-macro dialog
+    ((&rest args &key id layout binding (enabled-p t) (visible-p t) location
+	    size layout-manager parent title modal-p visible-p)
+     &body body)
+    `(funcall (lambda (&rest args) ;;to evaluate args only once
+		(let ((self (apply (function make-dialog) args)))
+		  (apply #'setup-widget self `(:visible-p nil , at args))
+		  (apply #'setup-container-widget self args)
+		  self))
+	      ;;remove id because it must not be evaluated
+	      ;;and visible-p because it must be set last
+	      ,@(filter-arglist args '(:id :visible-p)))
+  `(progn
+     ,@(generate-default-children-processing-code id body)
+     (setf (widget-visible-p self) ,visible-p)))
+
+#|
 (define-container-widget dialog (parent title modal-p)
-  make-dialog)
+  make-dialog)|#
 
 ;;Menus
 (definterface make-menu-bar *gui-backend* (&key &allow-other-keys))

Modified: trunk/src/lisp/snow/swing/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/swing.lisp	(original)
+++ trunk/src/lisp/snow/swing/swing.lisp	Thu Nov 26 17:20:33 2009
@@ -145,8 +145,7 @@
 		    (jfield "java.awt.Dialog$ModalityType" "APPLICATION_MODAL")
 		    (jfield "java.awt.Dialog$ModalityType" "MODELESS")))))
     (set-widget-properties d
-      :title title 
-      :visible (jbool visible-p))
+      :title title)
     d))
 
 (defimplementation pack (*gui-backend* :swing) (window)




More information about the snow-cvs mailing list