[snow-cvs] r44 - in trunk: examples/swixml src/java/snow src/lisp/snow src/lisp/snow/swing
Alessio Stalla
astalla at common-lisp.net
Mon Jan 18 20:17:16 UTC 2010
Author: astalla
Date: Mon Jan 18 15:17:16 2010
New Revision: 44
Log:
Cleverer resource loading/compilation/evaluation which should make it easier to pass Java objects to Snow "scripts".
Theoretical (untested) support for "backing beans" i.e. widgets injected in jproperties, event listeners can be strings naming methods
Added:
trunk/src/java/snow/AbstractSnowlet.java
trunk/src/java/snow/Snowlet.java
Modified:
trunk/examples/swixml/helloworld.lisp
trunk/src/java/snow/Snow.java
trunk/src/lisp/snow/data-binding.lisp
trunk/src/lisp/snow/packages.lisp
trunk/src/lisp/snow/snow.lisp
trunk/src/lisp/snow/swing/swing.lisp
Modified: trunk/examples/swixml/helloworld.lisp
==============================================================================
--- trunk/examples/swixml/helloworld.lisp (original)
+++ trunk/examples/swixml/helloworld.lisp Mon Jan 18 15:17:16 2010
@@ -11,7 +11,7 @@
(panel (:layout "grow, wrap")
(label :text "Hello World!" :font (font "Georgia" 12 :bold)
:foreground :blue) ;;labelfor="tf"
- (text-field :id tf :text "Snow");;columns="20" TODO :var tf
+ (text-field :id tf :text "Snow");;columns="20"
(button :text "Click Here" :on-action #'submit))
(panel (:layout "dock south")
(label :text "Clicks:" :font (font "Georgia" 36 :bold))
Added: trunk/src/java/snow/AbstractSnowlet.java
==============================================================================
--- (empty file)
+++ trunk/src/java/snow/AbstractSnowlet.java Mon Jan 18 15:17:16 2010
@@ -0,0 +1,71 @@
+/*
+ * AbstractSnowlet.java
+ *
+ * Copyright (C) 2010 Alessio Stalla
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package snow;
+
+import javax.script.Bindings;
+import com.jgoodies.binding.PresentationModel;
+
+public abstract class AbstractSnowlet implements Snowlet {
+
+ private PresentationModel presentationModel;
+ private Object backingBean;
+
+ public Object eval() {
+ Bindings b = Snow.getScriptEngine().createBindings();
+ b.put("snow:*backing-bean*", backingBean);
+ b.put("snow:*presentation-model*", presentationModel);
+ try {
+ return eval(b);
+ } catch(Exception e) {
+ throw new RuntimeException("Exception while evaluating snowlet " + this, e);
+ }
+ }
+
+ protected abstract Object eval(Bindings bindings) throws Exception;
+
+ public PresentationModel getPresentationModel() {
+ return presentationModel;
+ }
+
+ public void setPresentationModel(PresentationModel presentationModel) {
+ this.presentationModel = presentationModel;
+ }
+
+ public Object getBackingBean() {
+ return backingBean;
+ }
+
+ public void setBackingBean(Object backingBean) {
+ this.backingBean = backingBean;
+ }
+}
\ No newline at end of file
Modified: trunk/src/java/snow/Snow.java
==============================================================================
--- trunk/src/java/snow/Snow.java (original)
+++ trunk/src/java/snow/Snow.java Mon Jan 18 15:17:16 2010
@@ -32,27 +32,20 @@
package snow;
-import java.io.File;
-import java.io.FileOutputStream;
-import java.io.IOException;
-import java.io.InputStreamReader;
-import java.io.Reader;
import java.net.URI;
import java.net.URISyntaxException;
import java.net.URL;
import java.util.zip.ZipEntry;
import java.util.zip.ZipInputStream;
-import javax.script.Compilable;
-import javax.script.Invocable;
-import javax.script.ScriptEngine;
-import javax.script.ScriptEngineManager;
-import javax.script.ScriptException;
+import javax.script.*;
import java.security.*;
import org.armedbear.lisp.Interpreter;
+import com.jgoodies.binding.PresentationModel;
+
import java.io.*;
public abstract class Snow {
@@ -197,16 +190,21 @@
}
}
- public static synchronized ScriptEngine initIfNecessary() throws ScriptException {
+ public static synchronized ScriptEngine initIfNecessary() {
if(!init) {
- init();
+ try {
+ init();
+ } catch(ScriptException e) {
+ throw new RuntimeException("Snow initialization failed", e);
+ }
}
return lispEngine;
}
-
+
/**
* Compiles and loads a Lisp file from the classpath, relative to aClass.
*/
+ @Deprecated
public static Object evalResource(Class<?> aClass, String resourcePath) throws ScriptException {
return evalResource(aClass, resourcePath, true);
}
@@ -214,23 +212,28 @@
/**
* Loads a Lisp file from the classpath, relative to aClass. If compileItFirst is true, the file is compiled before being loaded.
*/
+ @Deprecated
public static Object evalResource(Class<?> aClass, String resourcePath, boolean compileItFirst) throws ScriptException {
Reader r = new InputStreamReader(aClass.getResourceAsStream(resourcePath));
return evalResource(r, compileItFirst);
}
+ @Deprecated
public static Object evalResource(String resourcePath) throws ScriptException {
return evalResource(Snow.class, resourcePath, true);
}
+ @Deprecated
public static Object evalResource(String resourcePath, boolean compileItFirst) throws ScriptException {
return evalResource(Snow.class, resourcePath, compileItFirst);
}
+ @Deprecated
public static Object evalResource(Reader reader) throws ScriptException {
return evalResource(reader, true);
}
+ @Deprecated
public static Object evalResource(Reader reader, boolean compileItFirst) throws ScriptException {
initIfNecessary();
if(compileItFirst) {
@@ -239,6 +242,57 @@
return lispEngine.eval(reader);
}
}
+
+ /**
+ * Returns a Snowlet running interpreted code read from the provided Reader.
+ * This Snowlet's eval() method may only be called once.
+ */
+ public static Snowlet getInterpretedSnowlet(final Reader reader) {
+ initIfNecessary();
+ return new AbstractSnowlet() {
+ private boolean eval = false;
+ public Object eval(Bindings bindings) throws Exception {
+ if(!eval) {
+ eval = true;
+ } else {
+ throw new IllegalStateException("Already evaluated");
+ }
+ return lispEngine.eval(reader, bindings);
+ }
+ };
+ }
+
+ public static Snowlet getInterpretedSnowlet(final URL url) {
+ initIfNecessary();
+ return new AbstractSnowlet() {
+ public Object eval(Bindings bindings) throws Exception {
+ return lispEngine.eval(new InputStreamReader(url.openStream()), bindings);
+ }
+ };
+ }
+
+ public static Snowlet getCompiledSnowlet(final Reader reader) {
+ initIfNecessary();
+ final CompiledScript c;
+ try {
+ c = getCompilable().compile(reader);
+ } catch(ScriptException e) {
+ throw new RuntimeException("Compilation error", e);
+ }
+ return new AbstractSnowlet() {
+ public Object eval(Bindings bindings) throws Exception {
+ return c.eval(bindings);
+ }
+ };
+ }
+
+ public static Snowlet getCompiledSnowlet(final URL url) {
+ try {
+ return getCompiledSnowlet(new InputStreamReader(url.openStream()));
+ } catch(IOException e) {
+ throw new RuntimeException("Couldn't open stream for URL: " + url, e);
+ }
+ }
public static ScriptEngine getScriptEngine() {
return lispEngine;
@@ -254,19 +308,19 @@
public static void main(final String[] args) {
try {
+ //Needed for Java WebStart
+ Policy.setPolicy
+ (new Policy() {
+ public PermissionCollection getPermissions(CodeSource codesource) {
+ Permissions perms = new Permissions();
+ perms.add(new AllPermission());
+ return (perms);
+ }
+ });
if(args.length == 0) { //Launch GUI REPL
- evalResource(Snow.class, "/snow/start.lisp", false);
+ getCompiledSnowlet(Snow.class.getResource("/snow/start.lisp")).eval();
} else if("--showcase".equals(args[0])) {
- //Needed for Java WebStart
- Policy.setPolicy
- (new Policy() {
- public PermissionCollection getPermissions(CodeSource codesource) {
- Permissions perms = new Permissions();
- perms.add(new AllPermission());
- return (perms);
- }
- });
- evalResource(Snow.class, "/snow/showcase/showcase.lisp", false);
+ getInterpretedSnowlet(Snow.class.getResource("/snow/showcase/showcase.lisp")).eval();
getInvocable().invokeFunction("snow-showcase::showcase", true);
} else {//Launch regular ABCL
//Copied from org.armedbear.lisp.Main.main()
Added: trunk/src/java/snow/Snowlet.java
==============================================================================
--- (empty file)
+++ trunk/src/java/snow/Snowlet.java Mon Jan 18 15:17:16 2010
@@ -0,0 +1,53 @@
+/*
+ * Snowlet.java
+ *
+ * Copyright (C) 2010 Alessio Stalla
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package snow;
+
+import com.jgoodies.binding.PresentationModel;
+
+public interface Snowlet {
+
+ /**
+ * Runs the snowlet.
+ * @return whatever the snowlet code returns.
+ */
+ public Object eval();
+
+ public PresentationModel getPresentationModel();
+
+ public void setPresentationModel(PresentationModel presentationModel);
+
+ public Object getBackingBean();
+
+ public void setBackingBean(Object backingBean);
+
+}
\ No newline at end of file
Modified: trunk/src/lisp/snow/data-binding.lisp
==============================================================================
--- trunk/src/lisp/snow/data-binding.lisp (original)
+++ trunk/src/lisp/snow/data-binding.lisp Mon Jan 18 15:17:16 2010
@@ -1,4 +1,4 @@
-;;; binding-jgoodies.lisp
+;;; data-binding.lisp
;;;
;;; Copyright (C) 2008-2009 Alessio Stalla
;;;
@@ -117,9 +117,11 @@
"triggerCommit")
presentation-model))
-(defmacro form ((bean) &body body)
- `(let ((*presentation-model*
- (new "com.jgoodies.binding.PresentationModel" ,bean)))
+(defun make-default-presentation-model (bean)
+ (new "com.jgoodies.binding.PresentationModel" bean))
+
+(defmacro with-presentation-model (pm &body body)
+ `(let ((*presentation-model* ,pm))
, at body))
(defclass bean-data-binding (data-binding)
Modified: trunk/src/lisp/snow/packages.lisp
==============================================================================
--- trunk/src/lisp/snow/packages.lisp (original)
+++ trunk/src/lisp/snow/packages.lisp Mon Jan 18 15:17:16 2010
@@ -84,13 +84,17 @@
#:make-simple-data-binding
#:make-slot-data-binding
#:bean
- #:cell
+ #:cell
#:slot
#:var
+ #:*presentation-model*
#:simple-data-binding
+ #:with-presentation-model
;;Various
+ #:*backing-bean*
#:call-in-gui-thread
#:color
+ #:&common-widget-args
#:defimplementation
#:definterface
#:font
Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp (original)
+++ trunk/src/lisp/snow/snow.lisp Mon Jan 18 15:17:16 2010
@@ -89,12 +89,12 @@
`(if *dynamic-environment*
(with-dynamic-environment (*dynamic-environment*)
, at body)
- (let* ((,gui-backend-var *gui-backend*)
- (,package-var *package*)
- (,terminal-io-var *terminal-io*)
- (,standard-input-var *standard-input*)
- (,standard-output-var *standard-output*)
- (,error-output-var *error-output*)) ;;Etc...
+ (let ((,gui-backend-var *gui-backend*)
+ (,package-var *package*)
+ (,terminal-io-var *terminal-io*)
+ (,standard-input-var *standard-input*)
+ (,standard-output-var *standard-output*)
+ (,error-output-var *error-output*)) ;;Etc...
(dynamic-wind
(let ((*gui-backend* ,gui-backend-var)
(*package* ,package-var)
@@ -276,7 +276,17 @@
#+emacs (put 'define-widget 'lisp-indent-function 3)
#+emacs (put 'define-container-widget 'lisp-indent-function 3)
+(defvar *backing-bean* nil)
+
+(defun maybe-inject-widget (widget property-name)
+ (when *backing-bean*
+ ;;sub-optimal: should ignore property not found, but propagate other errors
+ (ignore-errors (setf (jproperty-value *backing-bean* property-name)
+ widget))))
+
(defmacro define-widget-macro (name arglist constructor &body body)
+ "Defines a macro that expands to code constructing and initializing a widget, and setting up the environment expected by Snow. <arglist> must contain exactly one occurrence of the symbol snow:&common-widget-args, which define-widget-macro will replace with the common part of the argument list of every widget macro."
+ ;;Todo check that arglist contains exactly one &common-widget-args
(with-unique-names (env)
`(progn
(defmacro ,name ,(append (splice-into (common-widget-args)
@@ -289,8 +299,10 @@
(if (sys:variable-information id ,env) ;;id is lexically bound
`(progn
(setf ,id self)
+ (maybe-inject-widget self ,(dashed->camelcased id))
,, at body)
`(let ((,id self))
+ (maybe-inject-widget self ,(dashed->camelcased id))
,, at body))
`(progn ,, at body))
self))
@@ -345,22 +357,3 @@
(defmacro dont-add (&body body)
`(let ((*parent* nil))
, at body))
-
-#|| (with-unique-names (gui-backend-var package-var
- dynamic-environment terminal-io-var)
- `(let* ((,gui-backend-var ,gui-backend)
- (*gui-backend* ,gui-backend-var)
- (,package-var *package*)
- (,terminal-io-var *terminal-io*)) ;;Etc...
- (dynamic-wind
- (let ((*gui-backend* ,gui-backend-var)
- (*package* ,package-var)
- (*debugger-hook* *graphical-debugger-hook*)
- (*terminal-io* ,terminal-io-var))
- (proceed
- (let ((,dynamic-environment (capture-dynamic-environment)))
- (call-in-gui-thread
- (lambda ()
- (with-dynamic-environment (,dynamic-environment)
- (let ((*dynamic-environment* ,dynamic-environment))
- , at body)))))))))))||#
\ No newline at end of file
Modified: trunk/src/lisp/snow/swing/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/swing.lisp (original)
+++ trunk/src/lisp/snow/swing/swing.lisp Mon Jan 18 15:17:16 2010
@@ -40,18 +40,23 @@
, at body))
(defun make-action-listener (obj)
- (if (or (functionp obj) (symbolp obj))
- (jmake-proxy "java.awt.event.ActionListener"
- (snow::lambda/dynamic-environment (this method-name event)
- (funcall obj event)))
-; (let ((env (or snow::*dynamic-environment*
-; (snow::capture-dynamic-environment))))
-; (lambda (this method-name event)
-; (declare (ignore this method-name))
-; (snow::with-dynamic-environment (env)
-; (let ((snow::*dynamic-environment* env))
-; (funcall obj event))))))
- obj)) ;This allows to use a native Java action listener
+ (cond
+ ((or (functionp obj) (symbolp obj))
+ (jmake-proxy "java.awt.event.ActionListener"
+ (snow::lambda/dynamic-environment (this method-name event)
+ (funcall obj event))))
+ ((stringp obj)
+ (unless *backing-bean*
+ (error "No backing bean specified while action listener is a method name: ~A~%" obj))
+ (make-action-listener (jmethod (jclass-of *backing-bean*) obj
+ (jclass "java.awt.ActionEvent"))))
+ ((jinstance-of-p obj (jclass "java.lang.reflect.Method"))
+ (unless *backing-bean*
+ (error "No backing bean specified while action listener is a jmethod: ~A~%" obj))
+ (make-action-listener
+ (let ((bb *backing-bean*))
+ #'(lambda (evt) (jcall obj bb evt)))))
+ (t obj))) ;This allows to use a native Java action listener
(defimpl make-layout-manager (widget layout &rest args)
(if (typep layout 'java-object)
More information about the snow-cvs
mailing list