[armedbear-cvs] r12773 - trunk/abcl/src/org/armedbear/lisp

[Alessio Stalla]

Author: astalla
Date: Thu Jul  1 16:57:11 2010
New Revision: 12773

Log:
Added classpath manipulation primitives: java:add-to-classpath and java:dump-classpath


Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java
   trunk/abcl/src/org/armedbear/lisp/Pathname.java

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Thu Jul  1 16:57:11 2010
@@ -514,6 +514,9 @@
         autoload(PACKAGE_JAVA, "%jregister-handler", "JHandler");
         autoload(PACKAGE_JAVA, "%load-java-class-from-byte-array", "RuntimeClass");
         autoload(PACKAGE_JAVA, "get-default-classloader", "JavaClassLoader");
+        autoload(PACKAGE_JAVA, "make-classloader", "JavaClassLoader");
+        autoload(PACKAGE_JAVA, "add-to-classpath", "JavaClassLoader");
+        autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader");
         autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false);
         autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
         autoload(PACKAGE_MOP, "method-qualifiers", "StandardMethod", true);

Modified: trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java	Thu Jul  1 16:57:11 2010
@@ -39,8 +39,9 @@
 import java.util.HashSet;
 import java.util.Set;
 import java.net.URL;
+import java.net.URLClassLoader;
 
-public class JavaClassLoader extends java.net.URLClassLoader {
+public class JavaClassLoader extends URLClassLoader {
 
     private static JavaClassLoader persistentInstance;
 
@@ -168,6 +169,92 @@
         }
     };
 
+    private static final Primitive DUMP_CLASSPATH = new pf_dump_classpath();
+    private static final class pf_dump_classpath extends Primitive 
+    {
+        pf_dump_classpath() 
+        {
+            super("dump-classpath", PACKAGE_JAVA, true, "&optional classloader");
+        }
+
+        @Override
+        public LispObject execute() {
+	    return execute(new JavaObject(getCurrentClassLoader()));
+        }
+
+        @Override
+        public LispObject execute(LispObject classloader) {
+	    LispObject list = NIL;
+	    Object o = classloader.javaInstance();
+	    while(o instanceof ClassLoader) {
+		ClassLoader cl = (ClassLoader) o;
+		list = list.push(dumpClassPath(cl));
+		o = cl.getParent();
+	    }
+	    return list.nreverse();
+        }
+    };
+
+    private static final Primitive ADD_TO_CLASSPATH = new pf_add_to_classpath();
+    private static final class pf_add_to_classpath extends Primitive 
+    {
+        pf_add_to_classpath() 
+        {
+            super("add-to-classpath", PACKAGE_JAVA, true, "jar-or-jars &optional (classloader (get-current-classloader))");
+        }
+
+        @Override
+        public LispObject execute(LispObject jarOrJars) {
+	    return execute(jarOrJars, new JavaObject(getCurrentClassLoader()));
+        }
+
+        @Override
+        public LispObject execute(LispObject jarOrJars, LispObject classloader) {
+	    Object o = classloader.javaInstance();
+	    if(o instanceof JavaClassLoader) {
+		JavaClassLoader jcl = (JavaClassLoader) o;
+		if(jarOrJars instanceof Cons) {
+		    while(jarOrJars != NIL) {
+			addURL(jcl, jarOrJars.car());
+			jarOrJars = jarOrJars.cdr();
+		    }
+		} else {
+		    addURL(jcl, jarOrJars);
+		}
+		return T;
+	    } else {
+		return error(new TypeError(o + " must be an instance of " + JavaClassLoader.class.getName()));
+	    }
+        }
+    };
+
+    protected static void addURL(JavaClassLoader jcl, LispObject jar) {
+	try {
+	    if(jar instanceof Pathname) {
+		jcl.addURL(((Pathname) jar).toURL());
+	    } else if(jar instanceof AbstractString) {
+		jcl.addURL(new Pathname(jar.toString()).toURL());
+	    } else {
+		error(new TypeError(jar + " must be a pathname designator"));
+	    }
+	} catch(java.net.MalformedURLException e) {
+	    error(new LispError(jar + " is not a valid URL"));
+	}
+    }
+
+
+    public static LispObject dumpClassPath(ClassLoader o) {
+	if(o instanceof URLClassLoader) {
+	    LispObject list = NIL;
+	    for(URL u : ((URLClassLoader) o).getURLs()) {
+		list = list.push(new Pathname(u));
+	    }
+	    return new Cons(new JavaObject(o), list.nreverse());
+	} else {
+	    return new JavaObject(o);
+	}
+    }
+
     public static ClassLoader getCurrentClassLoader() {
 	LispObject classLoader = CLASSLOADER.symbolValueNoThrow();
 	if(classLoader != null) {

Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java	Thu Jul  1 16:57:11 2010
@@ -2342,6 +2342,22 @@
         return getNamestring();
     }
 
+    public URL toURL() throws MalformedURLException {
+	if(isURL()) {
+	    return new URL(getNamestring());
+	} else {
+	    return toFile().toURL();
+	}
+    }
+
+    public File toFile() {
+	if(!isURL()) {
+	    return new File(getNamestring());
+	} else {
+	    throw new RuntimeException(this + " does not represent a file");
+	}
+    }
+
     static {
         LispObject obj = Symbol.DEFAULT_PATHNAME_DEFAULTS.getSymbolValue();
         Symbol.DEFAULT_PATHNAME_DEFAULTS.setSymbolValue(coerceToPathname(obj));