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

[Alessio Stalla]

Author: astalla
Date: Tue Apr 20 14:49:00 2010
New Revision: 77

Log:
Use Mark Evenson's support to ASDF systems in Jar files in ABCL to load Snow.


Modified:
   trunk/src/java/snow/Snow.java
   trunk/src/lisp/snow/compile-system.lisp

Modified: trunk/src/java/snow/Snow.java
==============================================================================
--- trunk/src/java/snow/Snow.java	(original)
+++ trunk/src/java/snow/Snow.java	Tue Apr 20 14:49:00 2010
@@ -52,7 +52,6 @@
 
     private static boolean init = false;
     private static ScriptEngine lispEngine;
-    private static final String fileSeparator = System.getProperty("file.separator");
         
     /**
      * This method is public only because it needs to be called from Lisp.
@@ -70,12 +69,23 @@
 	    URL url = Snow.class.getResource("/snow/snow.asd");
 	    if(url == null) {
 		throw new RuntimeException("snow.asd not found in classpath: have you installed Snow correctly?");
+	    } else {
+		try {
+		    url = new URL(url.toString().substring(0, url.toString().length() - "/snow.asd".length()));
+		} catch(Exception e) {
+		    assert(false);
+		}
 	    }
 	    String baseDir;
 	    String libDir;
+	    String pathSeparator;
 	    if(!"file".equals(url.getProtocol())) {
 		if("jar".equals(url.getProtocol())) {
-		    ZipInputStream extractor = null;
+		    pathSeparator = "/";
+		    baseDir = fixPath(url.toString(), pathSeparator);
+		    baseDir = baseDir.substring(0, baseDir.length() - "snow/".length());
+		    libDir = baseDir;
+		    /*ZipInputStream extractor = null;
 		    try {
 			String tmpDir = System.getProperty("java.io.tmpdir");
 			if(tmpDir != null && fileSeparator != null) {
@@ -134,7 +144,7 @@
 				e.printStackTrace();
 			    }
 			}
-		    }
+			}*/
 		} else {
 		    throw new RuntimeException("Unsupported URL for snow.asd: " + url +
 					       " make sure it is a regular file or is in a jar.");
@@ -147,39 +157,33 @@
 		    throw new RuntimeException(e);
 		}
 		File f = new File(uri);
-		baseDir = fixDirPath(f.getParentFile().getParent());
-		libDir = baseDir; 
+		pathSeparator = System.getProperty("file.separator");
+		baseDir = fixPath(f.getParentFile().getAbsolutePath(), pathSeparator);
+		libDir = baseDir;
 	    }
-	    addToAsdfCentralRegistry(lispEngine, baseDir, "snow");
-	    addToAsdfCentralRegistry(lispEngine, baseDir, "snow", "swing");
-	    addToAsdfCentralRegistry(lispEngine, libDir, "cl-utilities");
-	    addToAsdfCentralRegistry(lispEngine, libDir, "named-readtables");
-	    addToAsdfCentralRegistry(lispEngine, libDir, "cells");
-	    addToAsdfCentralRegistry(lispEngine, libDir, "cells", "utils-kt");
+	    addToAsdfCentralRegistry(lispEngine, baseDir + "snow" + pathSeparator);
+	    addToAsdfCentralRegistry(lispEngine, baseDir + "snow" + pathSeparator + "swing"+ pathSeparator);
+	    addToAsdfCentralRegistry(lispEngine, libDir + "cl-utilities" + pathSeparator);
+	    addToAsdfCentralRegistry(lispEngine, libDir + "named-readtables" + pathSeparator);
+	    addToAsdfCentralRegistry(lispEngine, libDir + "cells" + pathSeparator);
+	    addToAsdfCentralRegistry(lispEngine, libDir + "cells" + pathSeparator + "utils-kt" + pathSeparator);
 	}
     }
 
-    private static Object addToAsdfCentralRegistry(ScriptEngine lispEngine, String base, String... path) throws ScriptException {
-	return lispEngine.eval("(pushnew #P\"" + makePath(base, path) + "\" asdf:*central-registry* :test #'equal)");
+    private static Object addToAsdfCentralRegistry(ScriptEngine lispEngine, String path) throws ScriptException {
+	return lispEngine.eval("(pushnew #P\"" + path + "\" asdf:*central-registry* :test #'equal)");
     }
     
-    private static String makePath(String base, String... path) {
-	for(String s : path) {
-	    base = fixDirPath(base) + s;
-	}
-	return escapePath(fixDirPath(base));
-    }
-
     private static String escapePath(String str) {
 	//Replace single \ with double \ for Windows paths
 	return str.replace("\\", "\\\\"); 
     }
 
-    private static final String fixDirPath(String path) {
-	if(!path.endsWith(fileSeparator)) {
-	    path += fileSeparator;
+    private static final String fixPath(String path, String pathSeparator) {
+	if(!path.endsWith(pathSeparator)) {
+	    path += pathSeparator;
 	}
-	return path;
+	return escapePath(path);
     }
 
     public static synchronized ScriptEngine init(SplashScreen splashScreen)

Modified: trunk/src/lisp/snow/compile-system.lisp
==============================================================================
--- trunk/src/lisp/snow/compile-system.lisp	(original)
+++ trunk/src/lisp/snow/compile-system.lisp	Tue Apr 20 14:49:00 2010
@@ -5,8 +5,9 @@
 (let (*debugger-hook*)
   (handler-bind ((error
 		  #'(lambda (c)
-		      (format t "Compilation failed: ~A~%" c))))
-					;		    (quit :status 1))))
+		      (format t "Compilation failed: ~A~%" c)
+		      (quit :status 1))))
+    (setf *compile-verbose* t)
     (asdf:oos 'asdf:compile-op :snow)
     (format t "Success!~%")
     (quit)))
\ No newline at end of file