Changeset 11450

Timestamp:

12/15/08 03:31:04 (14 years ago)

Author:

astalla

Message:

JavaBean? property support (jproperty-value)
Minor code cleanup
Started jinterface-impl registration support on the Lisp side

Location:

branches/scripting/j/src/org/armedbear/lisp

Files:

• JProxy.java (modified) (1 diff)
• Java.java (modified) (3 diffs)
• autoloads.lisp (modified) (1 diff)
• java.lisp (modified) (1 diff)
• scripting/AbclScriptEngine.java (modified) (1 diff)
• scripting/AbclScriptEngineFactory.java (modified) (1 diff)
• scripting/lisp/abcl-script.lisp (modified) (1 diff)
• scripting/lisp/packages.lisp (modified) (1 diff)

branches/scripting/j/src/org/armedbear/lisp/JProxy.java

@@ -125 +125 @@
     //NEW IMPLEMENTATION by Alessio Stalla 
   
+    /**
+     * A weak map associating each proxy instance with a "Lisp-this" object. 
+     */
     private static final Map<Object, LispObject> proxyMap = new WeakHashMap<Object, LispObject>();
   

branches/scripting/j/src/org/armedbear/lisp/Java.java

@@ -22 +22 @@
 package org.armedbear.lisp;
 
+import java.beans.BeanInfo;
+import java.beans.IntrospectionException;
+import java.beans.Introspector;
+import java.beans.PropertyDescriptor;
 import java.lang.reflect.Array;
 import java.lang.reflect.Constructor;
@@ -28 +32 @@
 import java.lang.reflect.Method;
 import java.lang.reflect.Modifier;
+import java.util.HashMap;
 import java.util.Map;
-import java.util.HashMap;
 
 public final class Java extends Lisp
@@ -692 +696 @@
         }
     };
-
+    
+    private static final Primitive JGET_PROPERTY_VALUE =
+      new Primitive("%jget-property-value", PACKAGE_JAVA, true,
+                    "java-object property-name") {
+      
+      public LispObject execute(LispObject javaObject, LispObject propertyName) throws ConditionThrowable {
+      try {
+        Object obj = javaObject.javaInstance();
+        PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName);
+        return new JavaObject(pd.getReadMethod().invoke(obj));
+      } catch (Exception e) {
+        ConditionThrowable t = new ConditionThrowable("Exception in accessing property");
+        t.initCause(e);
+        throw t;
+      }
+        }
+    };
+    
+    private static final Primitive JSET_PROPERTY_VALUE =
+      new Primitive("%jset-property-value", PACKAGE_JAVA, true,
+                    "java-object property-name value") {
+      
+      public LispObject execute(LispObject javaObject, LispObject propertyName, LispObject value) throws ConditionThrowable {
+      try {
+              Object obj = javaObject.javaInstance();
+        PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName);
+        pd.getWriteMethod().invoke(obj, value.javaInstance());
+        return value;
+      } catch (Exception e) {
+        ConditionThrowable t = new ConditionThrowable("Exception in accessing property");
+        t.initCause(e);
+        throw t;
+      }
+        }
+    };
+    
+    private static PropertyDescriptor getPropertyDescriptor(Object obj, LispObject propertyName) throws ConditionThrowable, IntrospectionException {
+        String prop = ((AbstractString) propertyName).getStringValue();
+        BeanInfo beanInfo = Introspector.getBeanInfo(obj.getClass());
+        for(PropertyDescriptor pd : beanInfo.getPropertyDescriptors()) {
+          if(pd.getName().equals(prop)) {
+            return pd;
+          }
+        }
+    throw new ConditionThrowable("Property " + prop + " not found in " + obj);
+    }
+    
     private static Class classForName(String className) throws ConditionThrowable
     {

branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp

@@ -192 +192 @@
 (export 'jmake-proxy "JAVA")
 (autoload 'jmake-proxy "java")
+(export 'jproperty-value "JAVA")
+(autoload 'jproperty-value "java")
 (export 'jobject-class "JAVA")
 (autoload 'jobject-class "java")

branches/scripting/j/src/org/armedbear/lisp/java.lisp

@@ -279 +279 @@
       (error "Unknown load-from for ~A" class-name)))))
 
+(defun jproperty-value (obj prop)
+  (%jget-property-value obj prop))
+
+(defun (setf jproperty-value) (value obj prop)
+  (%jset-property-value obj prop value))
+
 (provide "JAVA-EXTENSIONS")

branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

@@ -327 +327 @@
   public ScriptEngineFactory getFactory() {
     return new AbclScriptEngineFactory();
-  }
-
-  public static String decoratedVariableName(String jvar) {
-    return jvar.toUpperCase();
   }
 

branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngineFactory.java

@@ -79 +79 @@
     sb.append(method);
     sb.append("\" ");
-    sb.append(AbclScriptEngine.decoratedVariableName(obj));
+    sb.append(obj);
     for(String arg : args) {
       sb.append(" ");
-      sb.append(AbclScriptEngine.decoratedVariableName(arg));
+      sb.append(arg);
     }
     sb.append(")");

branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

@@ -88 +88 @@
       (lambda ()
         ,@(read-from-string (concatenate 'string "(" code-string ")")))))))
+
+
+;;Java interface implementation
+
+(defvar *interface-implementation-map* (make-hash-table :test #'equal))
+
+(defun find-java-interface-implementation (interface)
+  (gethash interface *interface-implementation-map*))
+
+(defun register-java-interface-implementation (interface impl)
+  (setf (gethash interface *interface-implementation-map*) impl))
+
+(defun remove-java-interface-implementation (interface)
+  (remhash interface *interface-implementation-map*))
+
+(defun define-java-interface-implementation (interface implementation &optional lisp-this)
+  (register-java-interface-implementation
+   interface
+   (jmake-proxy interface implementation lisp-this)))

branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/packages.lisp

@@ -24 +24 @@
      #:define-java-interface-implementation
      #:find-java-interface-implementation
-     #:implement-java-interface))
+     #:register-java-interface-implementation
+     #:remove-java-interface-implementation))
   
 (defpackage :abcl-script-user