[snow-cvs] r72 - in trunk/src: java/snow lisp/snow

[Alessio Stalla]

Author: astalla
Date: Sun Apr 11 17:45:38 2010
New Revision: 72

Log:
call-in-gui-thread, and thus with-gui, now by default run the code synchronously on the EDT and return its return value. An optional parameter can be passed to require an asynchronous call, in which case NIL will be returned as before.


Modified:
   trunk/src/java/snow/FunctionRunnable.java
   trunk/src/lisp/snow/snow.lisp
   trunk/src/lisp/snow/start.lisp
   trunk/src/lisp/snow/swing.lisp

Modified: trunk/src/java/snow/FunctionRunnable.java
==============================================================================
--- trunk/src/java/snow/FunctionRunnable.java	(original)
+++ trunk/src/java/snow/FunctionRunnable.java	Sun Apr 11 17:45:38 2010
@@ -37,6 +37,7 @@
 public class FunctionRunnable implements Runnable {
 
     private LispObject function;
+    private LispObject retVal = Lisp.NIL;
 
     public FunctionRunnable(LispObject function) {
 	this.function = function;
@@ -44,10 +45,14 @@
     
     public void run() {
 	try {
-	    function.execute();
+	    retVal = function.execute();
 	} catch(Throwable e) {
 	    throw new RuntimeException(e);
 	}
     }
 
+    public LispObject getReturnedValue() {
+	return retVal;
+    }
+
 }
\ No newline at end of file

Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp	(original)
+++ trunk/src/lisp/snow/snow.lisp	Sun Apr 11 17:45:38 2010
@@ -69,10 +69,8 @@
 	      (let ((*dynamic-environment* ,dynamic-environment))
 		, at body)))))))
 
-(defmacro with-gui ((&rest args) &body body)
-  (declare (ignore args))
-  `(call-in-gui-thread
-    (lambda/dynamic-environment () , at body)))
+(defmacro with-gui ((&optional dont-wait) &body body)
+  `(call-in-gui-thread (lambda/dynamic-environment () , at body) ,dont-wait))
 
 (defun dashed->camelcased (string-designator)
   "Transforms a name (string designator) from the Lisp naming convention of separating multiple words with dashes to the Java camelCase convention."

Modified: trunk/src/lisp/snow/start.lisp
==============================================================================
--- trunk/src/lisp/snow/start.lisp	(original)
+++ trunk/src/lisp/snow/start.lisp	Sun Apr 11 17:45:38 2010
@@ -38,11 +38,11 @@
 	  :menu-bar (menu-bar ()
 		      (menu (:text "File")
 			(menu-item :text "Load..."
-				   :on-action #'snow-load)
+				   :on-action 'snow-load)
 			(menu-item :text "Compile..."
-				   :on-action #'snow-compile)
+				   :on-action 'snow-compile)
 			(menu-item :text "Compile and load..."
-				   :on-action #'snow-compile-and-load)
+				   :on-action 'snow-compile-and-load)
 			(separator)
 			(menu-item :text "Quit"
 				   :on-action (lambda () (ext:quit))))
@@ -51,9 +51,9 @@
 				    :on-action #'launch-swank))|#
 		      (menu (:text "Help")
 			(menu-item :text "Showcase"
-				   :on-action #'snow-showcase)
+				   :on-action 'snow-showcase)
 			(menu-item :text "About"
-				   :on-action #'snow-about))))
+				   :on-action 'snow-about))))
     (scroll (:layout "grow")
       (gui-repl :dispose-on-close frame
 		:environment `((*package* ,(find-package :snow-user))

Modified: trunk/src/lisp/snow/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing.lisp	(original)
+++ trunk/src/lisp/snow/swing.lisp	Sun Apr 11 17:45:38 2010
@@ -99,10 +99,17 @@
 
 (defconstant +add-to-container-with-constraints+ (jmethod "java.awt.Container" "add" "java.lang.String" "java.awt.Component"))
 
-(defun call-in-gui-thread (fn)
-  "Arranges <fn> to be called from a thread in which it is safe to create GUI components (for example, the Event Dispatching Thread in Swing)."
-  (jstatic "invokeLater" "javax.swing.SwingUtilities"
-	   (new "snow.FunctionRunnable" fn)))
+(defun call-in-gui-thread (fn &optional dont-wait)
+  "Arranges <fn> to be called from a thread in which it is safe to create GUI components (i.e., the Event Dispatching Thread in Swing). If <dont-wait> is NIL (the default), waits for the call to complete and returns the result of the call. Else, the call is executed asynchronously and NIL is returned."
+  (let ((runnable (jnew "snow.FunctionRunnable" fn))
+	(swing-utils (jclass "javax.swing.SwingUtilities")))
+    (if dont-wait
+	(jstatic "invokeLater" swing-utils runnable)
+	(if (jstatic "isEventDispatchThread" swing-utils)
+	    (funcall fn)
+	    (progn
+	      (jstatic "invokeAndWait" swing-utils runnable)
+	      (jcall "getReturnedValue" runnable))))))
 
 ;;Base API implementation
 (defun add-child (child &optional (parent *parent*) layout-constraints)