[snow-cvs] r4 - in trunk/src: java/snow lisp/snow lisp/snow/swing
Alessio Stalla
astalla at common-lisp.net
Mon Oct 12 20:29:11 UTC 2009
Author: astalla
Date: Mon Oct 12 16:29:10 2009
New Revision: 4
Log:
Properly implemented call-in-gui-thread for Swing.
Added:
trunk/src/java/snow/FunctionRunnable.java
Modified:
trunk/src/lisp/snow/snow.asd
trunk/src/lisp/snow/swing/binding-jgoodies.lisp
trunk/src/lisp/snow/swing/swing.lisp
Added: trunk/src/java/snow/FunctionRunnable.java
==============================================================================
--- (empty file)
+++ trunk/src/java/snow/FunctionRunnable.java Mon Oct 12 16:29:10 2009
@@ -0,0 +1,53 @@
+/*
+ * FunctionRunnable.java
+ *
+ * Copyright (C) 2009 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 org.armedbear.lisp.*;
+
+public class FunctionRunnable implements Runnable {
+
+ private LispObject function;
+
+ public FunctionRunnable(LispObject function) {
+ this.function = function;
+ }
+
+ public void run() {
+ try {
+ function.execute();
+ } catch(Throwable e) {
+ throw new RuntimeException(e);
+ }
+ }
+
+}
\ No newline at end of file
Modified: trunk/src/lisp/snow/snow.asd
==============================================================================
--- trunk/src/lisp/snow/snow.asd (original)
+++ trunk/src/lisp/snow/snow.asd Mon Oct 12 16:29:10 2009
@@ -38,6 +38,7 @@
(:file "utils")
(:file "snow")
(:file "repl")
+ (:file "data-binding")
(:file "backend")
(:file "debugger")
(:file "inspector")))
\ No newline at end of file
Modified: trunk/src/lisp/snow/swing/binding-jgoodies.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/binding-jgoodies.lisp (original)
+++ trunk/src/lisp/snow/swing/binding-jgoodies.lisp Mon Oct 12 16:29:10 2009
@@ -30,24 +30,6 @@
(in-package :snow)
-(defvar *presentation-model*)
-
-(defclass binding ()
- ((converter :initarg :converter :initform nil :accessor binding-converter)))
-
-(defgeneric make-model (binding))
-
-(defmethod make-model :around ((binding binding))
- (let ((model (call-next-method)))
- (with-slots (converter) binding
- (cond
- ((functionp converter)
- (new "snow.binding.Converter" model converter converter))
- ((consp converter)
- (new "snow.binding.Converter" model (car converter) (cdr converter)))
- ((null converter) model)
- (t (error "~A is not a valid converter" converter))))))
-
(defmethod bind-widget ((widget (jclass "javax.swing.JTextField")) binding)
(jstatic (jmethod "com.jgoodies.binding.adapter.Bindings"
"bind"
@@ -64,7 +46,7 @@
"com.jgoodies.binding.value.ValueModel")
nil widget (make-model binding)))
-(defmethod (setf widget-property) ((value binding) (widget (jclass "java.awt.Component")) name)
+(defmethod (setf widget-property) ((value data-binding) (widget (jclass "java.awt.Component")) name)
(jstatic (jmethod "com.jgoodies.binding.adapter.Bindings"
"bind"
"javax.swing.JComponent"
@@ -72,92 +54,3 @@
"com.jgoodies.binding.value.ValueModel")
nil widget (dashed->camelcased name) (make-model value))
value)
-
-(defun trigger-commit (&optional (presentation-model *presentation-model*))
- (jcall (jmethod "com.jgoodies.binding.PresentationModel"
- "triggerCommit")
- presentation-model))
-
-(defmacro form ((bean) &body body)
- `(let ((*presentation-model*
- (new "com.jgoodies.binding.PresentationModel" ,bean)))
- , at body))
-
-(defmacro make-action (args &body body)
- (with-unique-names (presentation-model)
- `(let ((,presentation-model *presentation-model*))
- (lambda ,args
- (let ((*presentation-model* ,presentation-model))
- , at body)))))
-
-;;Concrete Binding implementations
-
-;;Simple Binding
-(defclass simple-binding (binding)
- ((variable :initarg :variable :reader binding-variable :initform (error "variable is required"))))
-
-(defun make-var (&optional obj)
- (new "com.jgoodies.binding.value.ValueHolder" obj (jbool nil)))
-
-(defun var (var)
- (invoke "getValue" var))
-
-(defun (setf var) (value var)
- (invoke "setValue" var value)
- value)
-
-(defun make-simple-binding (variable)
- (make-instance 'simple-binding :variable variable))
-
-(defmethod make-model ((binding simple-binding))
- (binding-variable binding))
-
-;;Bean Binding
-(defclass bean-binding (binding)
- ((object :initarg :object :reader binding-object
- :initform (or *presentation-model* (error "object is required")))
- (property :initarg :property :reader binding-property
- :initform (error "property is required"))
- (observed-p :initarg :observed-p :reader binding-observed-p :initform t)
- (buffered-p :initarg :buffered-p :reader binding-buffered-p :initform nil)))
-
-(defun make-bean-binding (object property &rest args)
- (apply #'make-instance 'bean-binding :object object :property property
- args))
-
-(defmethod make-model ((binding bean-binding))
- (let ((presentation-model-class
- (jclass "com.jgoodies.binding.PresentationModel")))
- (if (jinstance-of-p (binding-object binding) presentation-model-class)
- (if (binding-buffered-p binding)
- (jcall (jmethod presentation-model-class
- "getBufferedModel" "java.lang.String")
- (binding-object binding)
- (dashed->camelcased (binding-property binding)))
- (jcall (jmethod presentation-model-class
- "getModel" "java.lang.String")
- (binding-object binding)
- (dashed->camelcased (binding-property binding))))
- (jnew (jconstructor "com.jgoodies.binding.beans.PropertyAdapter"
- "java.lang.Object" "java.lang.String"
- "boolean")
- (binding-object binding)
- (dashed->camelcased (binding-property binding))
- (jbool (binding-observed-p binding))))))
-
-;;Default binding types
-(defun default-binding-types ()
- (let ((ht (make-hash-table)))
- (setf (gethash :simple ht) 'simple-binding)
- (setf (gethash :bean ht) 'bean-binding)
- ht))
-
-(defparameter *binding-types* (default-binding-types))
-
-(defun get-binding-class (binding-type)
- (if (keywordp binding-type)
- (gethash binding-type *binding-types*)
- binding-type))
-
-(defun make-binding (type &rest options)
- (apply #'make-instance (get-binding-class type) options))
Modified: trunk/src/lisp/snow/swing/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/swing.lisp (original)
+++ trunk/src/lisp/snow/swing/swing.lisp Mon Oct 12 16:29:10 2009
@@ -64,8 +64,8 @@
(defconstant +add-to-container-with-constraints+ (jmethod "java.awt.Container" "add" "java.lang.String" "java.awt.Component"))
(defimplementation call-in-gui-thread (*gui-backend* :swing) (fn)
- ;TODO...
- (funcall fn))
+ (jstatic "invokeLater" "javax.swing.SwingUtilities"
+ (new "snow.FunctionRunnable" fn)))
;;Base API implementation
(defimplementation add-child (*gui-backend* :swing)
More information about the snow-cvs
mailing list