[armedbear-cvs] r12422 - in trunk/abcl: doc/design/pathnames src/org/armedbear/lisp
Mark Evenson
mevenson at common-lisp.net
Sat Feb 6 10:52:36 UTC 2010
Author: mevenson
Date: Sat Feb 6 05:52:32 2010
New Revision: 12422
Log:
Extensively reworked new implementation for specifiying jar pathnames.
Pathname namestrings that have the form "jar:URL!/ENTRY" now construct
references to the ENTRY within a jar file that is located by URL. The
most common use is the "file:" form of URL
(e.g. 'jar:file:/home/me/foo.jar!/foo.lisp') although any valid syntax
accepted by the java.net.URL constructor should work (such as
'jar:http://abcl-dynamic-install.googlecode.com/files/baz.jar!/a/b/eek.lisp').
The internal structure of a jar pathname has changed. Previously a
pathname with a DEVICE that was itself a pathname referenced a jar.
This convention was not able to simultaneously represent bothjar
entries that were themselves jar files as occurs with packed FASLs
within JARs and devices which refer to drive letters under Windows.
Now, a pathname which refers to a jar has a DEVICE which is a proper
list of at most two entries. The first entry always references the
"outer jar", and the second entry (if it exists) references the "inner
jar". Casual users are encouraged not to manipulate the "internal
structure" of jar pathname by setting its DEVICE directly, but instead
rely on namestring <--> pathname conversions.
Jar pathnames are only currently valid for use with LOAD, TRUENAME,
PROBE-FILE and pathname translation related functions (such as
MERGE-PATHNAMES, TRANSLATE-PATHNAME, etc.) Passing one to OPEN
currently signals an error. Jar pathnames do not currently work
with DIRECTORY or PROBE-DIRECTORY.
Jar pathnames work for ASDF systems packaged within JARs. We override
ASDF:LOAD-OP to load ASDF from JAR Pathnames by bypassing compilation
if the output location would be in a JAR file. Interaction with
ASDF-BINARY-LOCATIONS is currently untested.
Pathname now used as the basis of ABCL's internal routines for loading
FASLs replacing the use of strings, which simplifies a lot of the
behavior in looking for things to LOAD.
Fixed nasty shared structure bug on MERGE-PATHNAMES by implementing
(and using) a copy constructor for Pathname.
Implemented SYS:PATHNAME-JAR-P predicate for jar pathnames.
Removed ZipCache as it is no longer used now that we are using JVM's
implicit JAR caching.
WRITE-FILE-DATE works for jar pathnames, returning 0 for a
non-existent entry.
JAR-FILE tests now include loading FASLs from network location, which
means that these tests will fail if there is no network
connectivity. The tests initialization rewritten in Lisp, so it works
under Windows.
Allow of a top directory for creating hierarchially ZIPs with SYS:ZIP.
There is now a three argument version--PATHNAME PATHNAMES &OPTIONAL
TOPDIR--whereby all pathnames will be interpolated relative to topdir.
Implementation of SYS:UNZIP to unpack ZIP/JAR files.
JAR files always use '/' to name hierarchial entries. Pathname
translates '/' --> '\' under isPlatformWindows for all hierarchy
*except* reference to jar entries.
Pathname URL constructor under Windows to properly parses the
drive letter.
Ensure that *EXT:LISP-HOME* contains a directory.
Removed unused imports.
Converted Primitives to stack-trace friendly form where we touched the
source extensively anyways.
Added:
trunk/abcl/doc/design/pathnames/
trunk/abcl/doc/design/pathnames/abcl-jar-url.text
trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp
trunk/abcl/src/org/armedbear/lisp/unzip.java
Removed:
trunk/abcl/src/org/armedbear/lisp/ZipCache.java
Modified:
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
trunk/abcl/src/org/armedbear/lisp/FileStream.java
trunk/abcl/src/org/armedbear/lisp/Interpreter.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/LogicalPathname.java
trunk/abcl/src/org/armedbear/lisp/Pathname.java
trunk/abcl/src/org/armedbear/lisp/Site.java
trunk/abcl/src/org/armedbear/lisp/Stream.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/Utilities.java
trunk/abcl/src/org/armedbear/lisp/asdf.lisp
trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
trunk/abcl/src/org/armedbear/lisp/file_write_date.java
Added: trunk/abcl/doc/design/pathnames/abcl-jar-url.text
==============================================================================
--- (empty file)
+++ trunk/abcl/doc/design/pathnames/abcl-jar-url.text Sat Feb 6 05:52:32 2010
@@ -0,0 +1,259 @@
+JARs and JAR entries in ABCL
+============================
+
+Mark Evenson
+Created: 09 JAN 2010
+Modified: 24 JAN 2010
+
+Notes towards sketching an implementation of "jar:" references to be
+contained in PATHNAMEs within ABCL
+
+
+Goals
+-----
+
+1. Use Common Lisp pathnames to refer to entries in a JAR file.
+
+
+2. Use 'jar:' schema as documented in java.net.JarURLConnection for
+ namestring representation.
+
+An entry in a JAR file:
+ #p"jar:file:baz.jar!/foo"
+
+A JAR file:
+ #p"jar:file:baz.jar!/"
+
+A JAR file accessible via URL
+ #p"jar:http://example.org/abcl.jar!/"
+
+An entry in a ABCL FASL in a URL accessible JAR file
+ #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls"
+
+3. MERGE-PATHNAMES working for JAR entries
+
+ (merge-pathnames "foo-1.cls" "jar:jar:file:baz.jar!/foo.abcl!/foo._")
+ "jar:jar:file:baz.jar!/foo.abcl!/foo-1.cls"
+
+ (merge-pathnames "foo-1.cls" "jar:file:foo.abcl!/")
+ "jar:file:foo.abcl!/foo-1.cls"
+
+4. TRUENAME and PROBE-FILE working with "jar:"
+
+4.1 TRUENAME cannonicalizing the JAR reference.
+
+5. DIRECTORY working within JAR files (and within JAR in JAR).
+
+6. References "jar:<URL>" for all strings <URL> that java.net.URL can
+ resolve works.
+
+
+Implementation
+--------------
+
+Using PATHNAMES
+
+* A PATHNAME refering to a file within a JAR is known as a JAR
+ PATHNAME. It can either refer to the entire JAR file or an entry
+ within the JAR file.
+
+* A JAR PATHNAME always has a DEVICE which is a proper list. This
+ distinguishes it from other uses of Pathname.
+
+* The DEVICE of a JAR PATHNAME will be a list with either one or two
+ elements. The first element of the JAR PATHNAME can be either a
+ PATHNAME representing a JAR on the filesystem, or a SimpleString
+ representing a URL.
+
+* a PATHNAME occuring in the list in the DEVICE of a JAR PATHNAME is
+ known as a DEVICE PATHNAME.
+
+* If the DEVICE is a String it must be a String that successfully
+ constructs a URL via the java.net.URL(String) constructor
+
+* Only the first entry in the the DEVICE list may be a String.
+
+* Otherwise the the DEVICE PATHAME denotes the PATHNAME of the JAR file
+
+* The DEVICE PATHNAME list of enclosing JARs runs from outermost to
+ innermost.
+
+
+
+Use Cases
+---------
+
+// UC1 -- JAR
+pathname: {
+ namestring: "jar:file:foo/baz.jar!/"
+ device: (
+ pathname: {
+ device: "jar:file:"
+ directory: (:RELATIVE "foo")
+ name: "baz"
+ type: "jar"
+ }
+ )
+}
+
+
+// UC1 -- JAR entry
+pathname: {
+ namestring: "jar:file:baz.jar!/foo.abcl"
+ device: ( pathname: {
+ device: "jar:file:"
+ name: "baz"
+ type: "jar"
+ })
+ name: "foo"
+ type: "abcl"
+}
+
+
+// UC3 -- JAR file in a JAR entry
+pathname: {
+ namestring: "jar:jar:file:baz.jar!/foo.abcl!/"
+ device: (
+ pathname: {
+ name: "baz"
+ type: "jar"
+ }
+ pathname: {
+ name: "foo"
+ type: "abcl"
+ }
+ )
+}
+
+// UC4 -- JAR entry in a JAR entry with directories
+pathname: {
+ namestring: "jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls"
+ device: (
+ pathname {
+ directory: (:RELATIVE "a")
+ name: "bar"
+ type: "jar"
+ }
+ pathname {
+ directory: (:RELATIVE "b")
+ name: "foo"
+ type: "abcl"
+ }
+ )
+ directory: (:RELATIVE "this" "that")
+ name: "foo-20"
+ type: "cls"
+}
+
+// UC5 -- JAR Entry in a JAR Entry
+pathname: {
+ namestring: "jar:jar:file:a/foo/baz.jar!/foo.abcl!/a/b/bar-1.cls"
+ device: (
+ pathname: {
+ device: "jar:file:"
+ name: "baz"
+ type: "jar"
+ }
+ pathname: {
+ name: "foo"
+ type: "abcl"
+ }
+ )
+ name: "bar-1"
+ type: "cls"
+}
+
+// UC6 -- JAR entry in a http: accessible JAR file
+pathname: {
+ namestring: "jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class",
+ device: (
+ "http://example.org/abcl.jar"
+ pathname: {
+ directory: (:relative "org" "armedbear" "lisp")
+ name: "Version"
+ type: "class"
+ }
+}
+
+// UC7 -- JAR Entry in a JAR Entry in a URL accessible JAR FILE
+pathname: {
+ namestring "jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls"
+ device: (
+ "http://example.org/abcl.jar"
+ pathname: {
+ name: "foo"
+ type: "abcl"
+ }
+ )
+ name: "foo-1"
+ type: "cls"
+}
+
+// UC8 -- JAR in an absolute directory
+
+pathame: {
+ namestring: "jar:file:/a/b/foo.jar!/"
+ device: (
+ pathname: {
+ directory: (:ABSOLUTE "a" "b")
+ name: "foo"
+ type: "jar"
+ }
+ )
+}
+
+// UC9 -- JAR in an relative directory with entry
+pathname: {
+ namestring: "jar:file:a/b/foo.jar!/c/d/foo.lisp"
+ device: (
+ directory: (:RELATIVE "a" "b")
+ name: "foo"
+ type: "jar"
+ )
+ directory: (:RELATIVE "c" "d")
+ name: "foo"
+ type: "lisp
+}
+
+
+
+Problems
+--------
+
+1. DEVICE PATHNAMES require the context within the nested PATHNAME
+ structure to be interpreted correctly.
+
+Result: Be careful when manipulating PATHNAMEs that refer to JARs
+
+
+History
+-------
+
+In the use of PATHNAMEs linked by the DEVICE field, we found the problem
+that UNC path support uses the DEVICE field
+
+Result: JARs located on UNC mounts can't be referenced. via '\\'.
+
+ i.e. jar:jar:file:\\server\share\a\b\foo.jar!/this\that!/foo.java
+
+would not have
+
+Solution: Instead of having DEVICE point to a PATHNAME, have DEVICE
+be a list of PATHNAMES
+
+pathname: {
+ namestring: "jar:jar:file:\\server\share\foo.jar!/foo.abcl!/"
+ device: ( pathname: {
+ name: "foo"
+ type: "abcl"
+ }
+ pathname: {
+ host: "server"
+ device: "share"
+ name: "foo"
+ type: "jar"
+ }
+}
+
+Which order for the list? Outermost first or last? Outermost first.
+
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 Sat Feb 6 05:52:32 2010
@@ -667,6 +667,7 @@
autoload(PACKAGE_SYS, "simple-list-remove-duplicates", "simple_list_remove_duplicates");
autoload(PACKAGE_SYS, "single-float-bits", "FloatFunctions", true);
autoload(PACKAGE_SYS, "std-allocate-instance", "StandardObjectFunctions", true);
+ autoload(PACKAGE_SYS, "unzip", "unzip", true);
autoload(PACKAGE_SYS, "zip", "zip", true);
autoload(PACKAGE_SYS, "proxy-preloaded-function",
Modified: trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java Sat Feb 6 05:52:32 2010
@@ -246,69 +246,72 @@
return new JavaObject(new Hashtable());
}
- // ### proxy-preloaded-function
- final private static Primitive PROXY_PRELOADED_FUNCTION
- = new Primitive("proxy-preloaded-function", PACKAGE_SYS, false,
- "symbol name")
- {
- @Override
- final public LispObject execute(LispObject symbol, LispObject name) {
- LispThread thread = LispThread.currentThread();
- Symbol sym;
- Function fun;
- FunctionType fType = FunctionType.NORMAL;
-
- if (symbol instanceof Symbol)
- sym = (Symbol)symbol;
- else if (isValidSetfFunctionName(symbol)) {
- sym = (Symbol)symbol.cadr();
- fType = FunctionType.SETF;
- } else if (isValidMacroFunctionName(symbol)) {
- sym = (Symbol)symbol.cadr();
- fType = FunctionType.MACRO;
- } else {
- checkSymbol(symbol); // generate an error
- return null; // not reached
+ // ### proxy-preloaded-function symbol name => function
+ final private static Primitive PROXY_PRELOADED_FUNCTION = new proxy_preloaded_function();
+ final private static class proxy_preloaded_function extends Primitive {
+ proxy_preloaded_function() {
+ super("proxy-preloaded-function", PACKAGE_SYS, false,
+ "symbol name");
}
-
- LispObject cache = AUTOLOADING_CACHE.symbolValue(thread);
- if (cache instanceof Nil)
- // during EVAL-WHEN :compile-toplevel, this function will
- // be called without a caching environment; we'll need to
- // forward to the compiled function loader
- return loadCompiledFunction(name.getStringValue());
- else {
- LispObject[] cachedSyms = new LispObject[symsToSave.length];
- for (int i = 0; i < symsToSave.length; i++)
- cachedSyms[i] = symsToSave[i].symbolValue(thread);
-
- fun = new AutoloadedFunctionProxy(sym, name, cache,
- cachedSyms, fType);
- fun.setClassBytes((byte[])((Hashtable)cache.javaInstance())
- .get(name.getStringValue()));
+ @Override
+ final public LispObject execute(LispObject symbol, LispObject name) {
+ LispThread thread = LispThread.currentThread();
+ Symbol sym;
+ Function fun;
+ FunctionType fType = FunctionType.NORMAL;
+
+ if (symbol instanceof Symbol)
+ sym = (Symbol)symbol;
+ else if (isValidSetfFunctionName(symbol)) {
+ sym = (Symbol)symbol.cadr();
+ fType = FunctionType.SETF;
+ } else if (isValidMacroFunctionName(symbol)) {
+ sym = (Symbol)symbol.cadr();
+ fType = FunctionType.MACRO;
+ } else {
+ checkSymbol(symbol); // generate an error
+ return null; // not reached
+ }
+
+ LispObject cache = AUTOLOADING_CACHE.symbolValue(thread);
+ if (cache instanceof Nil)
+ // during EVAL-WHEN :compile-toplevel, this function will
+ // be called without a caching environment; we'll need to
+ // forward to the compiled function loader
+ return loadCompiledFunction(name.getStringValue());
+ else {
+ LispObject[] cachedSyms = new LispObject[symsToSave.length];
+ for (int i = 0; i < symsToSave.length; i++)
+ cachedSyms[i] = symsToSave[i].symbolValue(thread);
+
+ fun = new AutoloadedFunctionProxy(sym, name, cache,
+ cachedSyms, fType);
+ fun.setClassBytes((byte[])((Hashtable)cache.javaInstance())
+ .get(name.getStringValue()));
+ }
+ return fun;
}
-
- return fun;
- }
- };
-
- // ### function-preload
- final private static Primitive FUNCTION_PRELOAD
- = new Primitive("function-preload", PACKAGE_SYS, false, "name")
- {
- @SuppressWarnings("unchecked")
- @Override
- final public LispObject execute(LispObject name) {
- String namestring = name.getStringValue();
- LispThread thread = LispThread.currentThread();
- Hashtable cache
- = (Hashtable)AUTOLOADING_CACHE.symbolValue(thread).javaInstance();
-
- byte[] bytes = readFunctionBytes(namestring);
- cache.put(namestring, bytes);
-
- return T;
}
- };
+ // ### function-preload name => success
+ final private static Primitive FUNCTION_PRELOAD = new function_preload();
+ private static class function_preload extends Primitive {
+ function_preload() {
+ super("function-preload", PACKAGE_SYS, false, "name");
+ }
+ @SuppressWarnings("unchecked")
+ @Override
+ final public LispObject execute(LispObject name) {
+ String namestring = name.getStringValue();
+ LispThread thread = LispThread.currentThread();
+ Hashtable cache
+ = (Hashtable)AUTOLOADING_CACHE.symbolValue(thread).javaInstance();
+
+ Pathname pathname = new Pathname(namestring);
+ byte[] bytes = readFunctionBytes(pathname);
+ cache.put(namestring, bytes);
+
+ return T;
+ }
+ }
}
Modified: trunk/abcl/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FileStream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/FileStream.java Sat Feb 6 05:52:32 2010
@@ -280,12 +280,17 @@
{
final Pathname pathname;
- if(first instanceof Pathname) {
+ if (first instanceof Pathname) {
pathname = (Pathname) first;
}
else {
return type_error(first, Symbol.PATHNAME);
}
+ if (pathname.isJar()) {
+ error(new FileError("Direct stream input/output on entries in JAR files no currently supported.",
+ pathname));
+ }
+
final LispObject namestring = checkString(second);
LispObject elementType = third;
LispObject direction = fourth;
Modified: trunk/abcl/src/org/armedbear/lisp/Interpreter.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Interpreter.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Interpreter.java Sat Feb 6 05:52:32 2010
@@ -285,8 +285,8 @@
if (i + 1 < args.length) {
if (arg.equals("--load"))
Load.load(new Pathname(args[i + 1]),
- args[i + 1],
false, false, true);
+
else
Load.loadSystemFile(args[i + 1]);
++i;
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Sat Feb 6 05:52:32 2010
@@ -1201,134 +1201,63 @@
LispThread.currentThread());
}
+ @Deprecated
public static final LispObject loadCompiledFunction(final String namestring)
-
{
- byte[] bytes = readFunctionBytes(namestring);
+ Pathname name = new Pathname(namestring);
+ byte[] bytes = readFunctionBytes(name);
if (bytes != null)
return loadClassBytes(bytes);
return null;
}
- public static final byte[] readFunctionBytes(final String namestring)
- {
- final LispThread thread = LispThread.currentThread();
- final boolean absolute = Utilities.isFilenameAbsolute(namestring);
- LispObject device = NIL;
- final Pathname defaultPathname;
- if (absolute)
- {
- defaultPathname =
- coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread));
+ public static final byte[] readFunctionBytes(final Pathname name) {
+ final LispThread thread = LispThread.currentThread();
+ Pathname load = null;
+ LispObject truenameFasl = Symbol.LOAD_TRUENAME_FASL.symbolValue(thread);
+ LispObject truename = Symbol.LOAD_TRUENAME.symbolValue(thread);
+ Pathname fasl = null;
+ if (truenameFasl instanceof Pathname) {
+ load = Pathname.mergePathnames(name, (Pathname)truenameFasl, Keyword.NEWEST);
+ } else if (truename instanceof Pathname) {
+ load = Pathname.mergePathnames(name, (Pathname) truename, Keyword.NEWEST);
+ } else {
+ load = name;
}
- else
- {
- LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
- if (loadTruename instanceof Pathname)
- {
- defaultPathname = (Pathname) loadTruename;
- // We're loading a file.
- device = ((Pathname)loadTruename).getDevice();
- }
- else
- {
- defaultPathname =
- coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread));
- }
- }
- if (device instanceof Pathname) { //Loading from a jar
- URL url = null;
- String jar = ((Pathname)device).getNamestring();
- if(jar.startsWith("jar:")) {
- try {
- url = new URL(jar + "!/" + namestring);
- } catch (MalformedURLException ex) {
- Debug.trace(ex);
- }
- } else {
- url = Lisp.class.getResource(namestring);
- }
- if (url != null) {
- try {
- InputStream input = null;
- java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream();
- try {
- input = url.openStream();
- byte[] bytes = new byte[4096];
- int n = 0;
- while (n >= 0) {
- n = input.read(bytes, 0, 4096);
- if(n >= 0) {
- baos.write(bytes, 0, n);
- }
- }
- bytes = baos.toByteArray();
- return bytes;
- } finally {
- baos.close();
- if(input != null) {
- input.close();
- }
- }
- } catch (IOException e) {
- Debug.trace(e);
- }
- }
- error(new LispError("Unable to load " + namestring));
- return null; // not reached
- }
- Pathname pathname = new Pathname(namestring);
- final File file = Utilities.getFile(pathname, defaultPathname);
- if (file != null && file.isFile())
- {
- // The .cls file exists.
- try
- {
- byte[] bytes = readFunctionBytes(new FileInputStream(file),
- (int) file.length());
- // FIXME close stream!
- if (bytes != null)
- return bytes;
+ InputStream input = load.getInputStream();
+ byte[] bytes = new byte[4096];
+ try {
+ if (input == null) {
+ Debug.trace("Pathname: " + name);
+ Debug.trace("LOAD_TRUENAME_FASL: " + truenameFasl);
+ Debug.trace("LOAD_TRUENAME: " + truename);
+ Debug.assertTrue(input != null);
}
- catch (FileNotFoundException fnf) {
- error(new LispError("Unable to load " + pathname.writeToString()
- + ": " + fnf.getMessage()));
- return null; // not reached
- }
- return null; // not reached
- }
- try
- {
- LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
- String zipFileName = ((Pathname)loadTruename).getNamestring();
- ZipFile zipFile = ZipCache.getZip(zipFileName);
- try
- {
- ZipEntry entry = zipFile.getEntry(namestring);
- if (entry != null)
- {
- byte[] bytes = readFunctionBytes(zipFile.getInputStream(entry),
- (int) entry.getSize());
- if (bytes != null)
- return bytes;
- Debug.trace("Unable to load " + namestring);
- error(new LispError("Unable to load " + namestring));
- return null; // not reached
- }
+
+ int n = 0;
+ java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream();
+ try {
+ while (n >= 0) {
+ n = input.read(bytes, 0, 4096);
+ if (n >= 0) {
+ baos.write(bytes, 0, n);
+ }
+ }
+ } catch (IOException e) {
+ Debug.trace("Failed to read bytes from "
+ + "'" + name.getNamestring() + "'");
+ return null;
}
- finally
- {
- ZipCache.removeZip(zipFile.getName());
+ bytes = baos.toByteArray();
+ } finally {
+ try {
+ input.close();
+ } catch (IOException e) {
+ Debug.trace("Failed to close InputStream: " + e);
}
}
- catch (IOException t)
- {
- Debug.trace(t);
- }
- error(new FileError("File not found: " + namestring,
- new Pathname(namestring)));
- return null; // not reached
+ return bytes;
}
public static final Function makeCompiledFunctionFromClass(Class<?> c) {
@@ -2395,6 +2324,7 @@
Symbol.LOAD_PRINT.initializeSpecial(NIL);
Symbol.LOAD_PATHNAME.initializeSpecial(NIL);
Symbol.LOAD_TRUENAME.initializeSpecial(NIL);
+ Symbol.LOAD_TRUENAME_FASL.initializeSpecial(NIL);
Symbol.COMPILE_VERBOSE.initializeSpecial(T);
Symbol.COMPILE_PRINT.initializeSpecial(T);
Symbol._COMPILE_FILE_PATHNAME_.initializeSpecial(NIL);
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Sat Feb 6 05:52:32 2010
@@ -35,20 +35,9 @@
import static org.armedbear.lisp.Lisp.*;
-import java.io.ByteArrayInputStream;
-import java.io.ByteArrayOutputStream;
-import java.io.File;
-import java.io.FileInputStream;
-import java.io.FileNotFoundException;
import java.io.IOException;
import java.io.InputStream;
import java.net.URL;
-import java.net.URLDecoder;
-import java.util.Hashtable;
-import java.util.zip.ZipEntry;
-import java.util.zip.ZipException;
-import java.util.zip.ZipFile;
-import java.util.zip.ZipInputStream;
/* This file holds ABCL's (FASL and non-FASL) loading behaviours.
*
@@ -61,209 +50,143 @@
* The FASL loader takes over and retrieves the file being loaded
* from the special variable and continues loading from there.
*
- * Note: In order to prevent re-opening the ZIP file again and again,
- * ABCL keeps a cache of opened zip files, which are retrieved to load
- * .cls (compiled-function files) from the ZIP while loading the main
- * ._ file with FASL loading instructions.
*/
-
public final class Load
{
public static final LispObject load(String filename)
-
{
final LispThread thread = LispThread.currentThread();
return load(new Pathname(filename),
- filename,
Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
true);
}
-
- private static final File findLoadableFile(final String filename,
- final String dir)
- {
- File file = new File(dir, filename);
- if (!file.isFile()) {
- String extension = getExtension(filename);
- if (extension == null) {
- // No extension specified. Try appending ".lisp" or ".abcl".
- File lispFile = new File(dir, filename.concat(".lisp"));
- File abclFile = new File(dir, filename.concat(".abcl"));
- if (lispFile.isFile() && abclFile.isFile()) {
- if (abclFile.lastModified() > lispFile.lastModified()) {
- return abclFile;
- } else {
- return lispFile;
- }
- } else if (abclFile.isFile()) {
- return abclFile;
- } else if (lispFile.isFile()) {
- return lispFile;
+
+ /** @return Pathname of loadable file based on NAME, or null if
+ * none can be determined. */
+ private static final Pathname findLoadableFile(Pathname name) {
+ LispObject truename = Pathname.truename(name, false);
+ if (truename instanceof Pathname) {
+ Pathname t = (Pathname)truename;
+ if (t.name != NIL
+ && t.name != null) {
+ return t;
+ }
+ }
+ if (name.type == NIL
+ && (name.name != NIL || name.name != null)) {
+ Pathname lispPathname = new Pathname(name);
+ lispPathname.type = new SimpleString("lisp");
+ lispPathname.invalidateNamestring();
+ LispObject lisp = Pathname.truename(lispPathname, false);
+ Pathname abclPathname = new Pathname(name);
+ abclPathname.type = new SimpleString("abcl");
+ abclPathname.invalidateNamestring();
+ LispObject abcl = Pathname.truename(abclPathname, false);
+ if (lisp instanceof Pathname && abcl instanceof Pathname) {
+ lispPathname = (Pathname)lisp;
+ abclPathname = (Pathname)abcl;
+ long lispLastModified = lispPathname.getLastModified();
+ long abclLastModified = abclPathname.getLastModified();
+ if (abclLastModified > lispLastModified) {
+ return lispPathname;
+ } else {
+ return abclPathname;
+ }
+ } else if (abcl instanceof Pathname) {
+ return (Pathname) abcl;
+ } else if (lisp instanceof Pathname) {
+ return (Pathname) lisp;
+ }
+ }
+ if (name.isJar()) {
+ if (name.type.equals(NIL)) {
+ name.type = COMPILE_FILE_INIT_FASL_TYPE;
+ name.invalidateNamestring();
+ Pathname result = findLoadableFile(name);
+ if (result != null) {
+ return result;
+ }
+ name.type = new SimpleString(COMPILE_FILE_TYPE);
+ name.invalidateNamestring();
+ result = findLoadableFile(name);
+ if (result != null) {
+ return result;
}
}
- } else
- return file; // the file exists
- return null; // this is the error case: the file does not exist
- // no need to check again at the caller
+ }
+ return null;
}
public static final LispObject load(Pathname pathname,
- String filename,
boolean verbose,
boolean print,
boolean ifDoesNotExist)
{
- return load(pathname, filename, verbose, print, ifDoesNotExist, false);
+ return load(pathname, verbose, print, ifDoesNotExist, false);
}
- public static final LispObject load(Pathname pathname,
- String filename,
+ public static final LispObject load(final Pathname pathname,
boolean verbose,
boolean print,
boolean ifDoesNotExist,
boolean returnLastResult)
{
- String dir = null;
- if (!Utilities.isFilenameAbsolute(filename)) {
- dir = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS
- .symbolValue()).getNamestring();
- }
-
- String zipFileName = null;
- String zipEntryName = null;
- if (filename.startsWith("jar:file:")) {
- String s = new String(filename);
- s = s.substring(9);
- int index = s.lastIndexOf('!');
- if (index >= 0) {
- zipFileName = s.substring(0, index);
- zipEntryName = s.substring(index + 1);
- if (zipEntryName.length() > 0 && zipEntryName.charAt(0) == '/')
- zipEntryName = zipEntryName.substring(1);
- if (Utilities.isPlatformWindows) {
- if (zipFileName.length() > 0 && zipFileName.charAt(0) == '/')
- zipFileName = zipFileName.substring(1);
- }
- }
+ Pathname mergedPathname = null;
+ if (!pathname.isAbsolute() && !pathname.isJar()) {
+ Pathname pathnameDefaults
+ = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
+ mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults);
}
- File file = findLoadableFile(filename, dir);
- if (null == file && null == zipFileName) {
- if (ifDoesNotExist)
- return error(new FileError("File not found: " + filename, pathname));
- else
+ Pathname truename = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
+
+ if (truename == null || truename.equals(NIL)) {
+ if (ifDoesNotExist) {
+ return error(new FileError("File not found: " + pathname));
+ } else {
+ Debug.trace("Failed to load " + pathname.getNamestring());
return NIL;
- }
-
- if (checkZipFile(file)) {
- // Either we are loading a packed FASL (i.e. ZIP with suffix ".abcl")
- // Or we are loading from a JAR archive
- if (".abcl".equals(getExtension(file.getPath()))) {
- // So we adjust the value passed to
- // loadFileFromStream() to get any further loading
- // within this invocation of LOAD to work properly.
- filename = file.getPath();
- }
- zipFileName = file.getPath();
- zipEntryName = file.getName();
- }
-
- String truename = filename;
- ZipFile zipfile = null;
-
- boolean packedFASL = false;
-
- InputStream in = null;
- if (zipFileName != null) {
- try {
- zipfile = ZipCache.getZip(zipFileName);
- }
- catch (IOException e) {
- return error (new FileError("Zip file not found: " + filename, pathname));
- }
- ZipEntry entry = zipfile.getEntry(zipEntryName);
- if (null == entry) {
- // try appending "._" to base filename
- int index = zipEntryName.lastIndexOf('.');
- if (-1 == index) index = zipEntryName.length();
- zipEntryName = zipEntryName.substring(0, index).concat("._");
- entry = zipfile.getEntry(zipEntryName);
- }
- if (null == entry) {
- // try appending ".abcl" to base filename
- int index = zipEntryName.lastIndexOf('.');
- if (index == -1)
- index = zipEntryName.length();
- zipEntryName = zipEntryName.substring(0, index).concat(".abcl");
- entry = zipfile.getEntry(zipEntryName);
- if (entry != null)
- packedFASL = true;
- }
- if (null == entry) {
- // Try looking for ".lisp"
- int i = zipEntryName.lastIndexOf('.');
- if (i == -1) {
- i = zipEntryName.length();
- }
- zipEntryName = zipEntryName.substring(0, i).concat(".lisp");
- entry = zipfile.getEntry(zipEntryName);
- if (entry == null) {
- return error(new LispError("Failed to find " + zipEntryName + " in "
- + zipFileName + "."));
- }
}
+ }
- if (null == entry) {
- return error(new FileError("Can't find zip file entry "
- + zipEntryName, pathname));
- }
- if (".abcl".equals(getExtension(zipEntryName))) {
- packedFASL = true;
- }
- if (packedFASL) {
- // If we are loading a packed FASL from the JAR we
- // have to decompress it first, and seek for the '._'
- // init FASL.
- int i = zipEntryName.lastIndexOf('.');
- int j = zipEntryName.lastIndexOf('/');
- if(j >= i) {
- return error(new LispError("Invalid zip entry name: " + zipEntryName));
- }
- String subZipEntryName = zipEntryName.substring(j + 1, i).concat("._");
- in = Utilities.getZippedZipEntryAsInputStream(zipfile,
- zipEntryName,
- subZipEntryName);
- } else {
- try {
- in = zipfile.getInputStream(entry);
+ if (truename.type.getStringValue().equals(COMPILE_FILE_TYPE)
+ && Utilities.checkZipFile(truename))
+ {
+ String n = truename.getNamestring();
+ if (n.startsWith("jar:")) {
+ n = "jar:" + n + "!/" + truename.name.getStringValue() + "."
+ + COMPILE_FILE_INIT_FASL_TYPE;
+ } else {
+ n = "jar:file:" + n + "!/" + truename.name.getStringValue() + "."
+ + COMPILE_FILE_INIT_FASL_TYPE;
}
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
+ mergedPathname = new Pathname(n);
+ LispObject initTruename = Pathname.truename(mergedPathname);
+ if (initTruename == null || initTruename.equals(NIL)) {
+ String errorMessage
+ = "Loadable FASL not found for"
+ + "'" + pathname + "'"
+ + " in "
+ + "'" + mergedPathname + "'";
+ if (ifDoesNotExist) {
+ return error(new FileError(errorMessage, mergedPathname));
+ } else {
+ Debug.trace(errorMessage);
+ return NIL;
+ }
}
+ truename = (Pathname)initTruename;
}
- } else {
- try {
- in = new FileInputStream(file);
- truename = file.getCanonicalPath();
- }
- catch (FileNotFoundException e) {
- if (ifDoesNotExist)
- return error(new FileError("File not found: " + filename,
- pathname));
- else
- return NIL;
- }
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
- }
- }
+
+ InputStream in = truename.getInputStream();
+ Debug.assertTrue(in != null);
+
try {
-
- return loadFileFromStream(null, truename,
- new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER),
- verbose, print, false, returnLastResult);
+ return loadFileFromStream(pathname, truename,
+ new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER),
+ verbose, print, false, returnLastResult);
}
catch (FaslVersionMismatch e) {
FastStringBuffer sb =
@@ -280,14 +203,6 @@
return error(new LispError(e.getMessage()));
}
}
- if (zipfile != null) {
- try {
- ZipCache.removeZip(zipfile.getName());
- }
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
- }
- }
}
}
@@ -327,124 +242,86 @@
}
}
+ static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
+
public static final LispObject loadSystemFile(final String filename,
boolean verbose,
boolean print,
boolean auto)
{
- final int ARRAY_SIZE = 2;
- String[] candidates = new String[ARRAY_SIZE];
- final String extension = getExtension(filename);
- if (extension == null) {
- // No extension specified.
- candidates[0] = filename + '.' + COMPILE_FILE_TYPE;
- candidates[1] = filename.concat(".lisp");
- } else if (extension.equals(".abcl")) {
- candidates[0] = filename;
- candidates[1] =
- filename.substring(0, filename.length() - 5).concat(".lisp");
- } else
- candidates[0] = filename;
InputStream in = null;
Pathname pathname = null;
- String truename = null;
- for (int i = 0; i < ARRAY_SIZE; i++) {
- String s = candidates[i];
- if (s == null)
- break;
- ZipFile zipfile = null;
- final String dir = Site.getLispHome();
+ Pathname truename = null;
+ pathname = new Pathname(filename);
+ Pathname mergedPathname = Pathname.mergePathnames(pathname, Site.getLispHome());
+ truename = findLoadableFile(mergedPathname);
+ if (truename == null || truename.equals(NIL)) {
+ // Make an attempt to use the boot classpath
+ String path = pathname.asEntryPath();
+ URL url = Lisp.class.getResource(path);
+ if (url == null || url.toString().endsWith("/")) {
+ url = Lisp.class.getResource(path + ".abcl");
+ if (url == null) {
+ url = Lisp.class.getResource(path + ".lisp");
+ }
+ }
+ if (url == null) {
+ return error(new LispError("Failed to find loadable system file "
+ + "'" + path + "'"
+ + " in boot classpath."));
+ }
+ Pathname urlPathname = new Pathname(url);
+ truename = findLoadableFile(urlPathname);
+ if (truename == null) {
+ return error(new LispError("Failed to find loadable system file in boot classpath "
+ + "'" + url + "'"));
+ }
+ }
+
+ // Look for a init FASL inside a packed FASL
+ if (truename.type.writeToString().equals(COMPILE_FILE_TYPE) && Utilities.checkZipFile(truename)) {
+ Pathname init = new Pathname(truename.getNamestring());
+ init.type = COMPILE_FILE_INIT_FASL_TYPE;
+ LispObject t = Pathname.truename(init);
+ if (t instanceof Pathname) {
+ truename = (Pathname)t;
+ } else {
+ return error (new LispError("Failed to find loadable init FASL in "
+ + "'" + init.getNamestring() + "'"));
+ }
+ }
+
+ in = truename.getInputStream();
+
+ if (in != null) {
+ final LispThread thread = LispThread.currentThread();
+ final SpecialBindingsMark mark = thread.markSpecialBindings();
+ thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
try {
- if (dir != null) {
- File file = new File(dir, s);
- if (file.isFile()) {
- // File exists. For system files, we know the extension
- // will be .abcl if it is a compiled file.
- String ext = getExtension(s);
- if (ext.equalsIgnoreCase(".abcl")) {
- try {
- zipfile = ZipCache.getZip(file.getPath());
- String name = file.getName();
- int index = name.lastIndexOf('.');
- Debug.assertTrue(index >= 0);
- name = name.substring(0, index).concat("._");
- ZipEntry entry = zipfile.getEntry(name);
- if (entry != null) {
- in = zipfile.getInputStream(entry);
- truename = file.getCanonicalPath();
- }
- }
- catch (ZipException e) {
- // Fall through.
- }
- catch (IOException e) {
- // fall through
- }
- }
- if (in == null) {
- try {
- in = new FileInputStream(file);
- truename = file.getCanonicalPath();
- }
- catch (IOException e) {
- in = null;
- }
- }
- }
- } else {
- URL url = Lisp.class.getResource(s);
- if (url != null) {
- try {
- in = url.openStream();
- if ("jar".equals(url.getProtocol()) &&
- url.getPath().startsWith("file:"))
- pathname = new Pathname(url);
- truename = getPath(url);
- }
- catch (IOException e) {
- in = null;
- }
- }
- }
- if (in != null) {
- final LispThread thread = LispThread.currentThread();
- final SpecialBindingsMark mark = thread.markSpecialBindings();
- thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
- try {
- return loadFileFromStream(pathname, truename,
- new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER),
- verbose, print, auto);
- }
- catch (FaslVersionMismatch e) {
- FastStringBuffer sb =
- new FastStringBuffer("; Incorrect fasl version: ");
- sb.append(truename);
- System.err.println(sb.toString());
- }
- finally {
- thread.resetSpecialBindings(mark);
- try {
- in.close();
- }
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
- }
- }
+ Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
+ return loadFileFromStream(pathname, truename, stream,
+ verbose, print, auto);
+ } catch (FaslVersionMismatch e) {
+ FastStringBuffer sb =
+ new FastStringBuffer("; Incorrect fasl version: ");
+ sb.append(truename);
+ System.err.println(sb.toString());
+ } finally {
+ thread.resetSpecialBindings(mark);
+ try {
+ in.close();
}
- }
- finally {
- if (zipfile != null) {
- try {
- ZipCache.removeZip(zipfile.getName());
- }
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
- }
+ catch (IOException e) {
+ return error(new LispError(e.getMessage()));
}
}
}
- return error(new LispError("File not found: " + filename));
+ return error(new FileError("Failed to load system file: "
+ + "'" + filename + "'"
+ + " resolved as "
+ + "'" + mergedPathname + "'" ,
+ truename));
}
// ### *fasl-version*
@@ -468,10 +345,12 @@
public static final Symbol _FASL_ANONYMOUS_PACKAGE_ =
internSpecial("*FASL-ANONYMOUS-PACKAGE*", PACKAGE_SYS, NIL);
- // ### init-fasl
- private static final Primitive INIT_FASL =
- new Primitive("init-fasl", PACKAGE_SYS, true, "&key version")
- {
+ // ### init-fasl &key version
+ private static final Primitive INIT_FASL = new init_fasl();
+ private static class init_fasl extends Primitive {
+ init_fasl() {
+ super("init-fasl", PACKAGE_SYS, true, "&key version");
+ }
@Override
public LispObject execute(LispObject first, LispObject second)
@@ -487,10 +366,10 @@
}
throw new FaslVersionMismatch(second);
}
- };
+ }
- private static final LispObject loadFileFromStream(LispObject pathname,
- String truename,
+ private static final LispObject loadFileFromStream(Pathname pathname,
+ Pathname truename,
Stream in,
boolean verbose,
boolean print,
@@ -499,8 +378,9 @@
return loadFileFromStream(pathname, truename, in, verbose, print, auto, false);
}
+ // A nil TRUENAME signals a load from stream which has no possible path
private static final LispObject loadFileFromStream(LispObject pathname,
- String truename,
+ LispObject truename,
Stream in,
boolean verbose,
boolean print,
@@ -525,12 +405,35 @@
thread.bindSpecialToCurrentValue(_EXPLAIN_);
final String prefix = getLoadVerbosePrefix(loadDepth);
try {
- if (pathname == null && truename != null)
- pathname = Pathname.parseNamestring(truename);
- thread.bindSpecial(Symbol.LOAD_PATHNAME,
- pathname != null ? pathname : NIL);
- thread.bindSpecial(Symbol.LOAD_TRUENAME,
- pathname != null ? pathname : NIL);
+ thread.bindSpecial(Symbol.LOAD_PATHNAME, pathname);
+ Pathname truePathname = new Pathname(((Pathname)truename).getNamestring());
+ String type = truePathname.type.getStringValue();
+ if (type.equals(COMPILE_FILE_TYPE)
+ || type.equals(COMPILE_FILE_INIT_FASL_TYPE.toString())) {
+ thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truePathname);
+ }
+ if (truePathname.type.getStringValue().equals(COMPILE_FILE_INIT_FASL_TYPE.getStringValue())
+ && truePathname.isJar()) {
+ if (truePathname.device.cdr() != NIL ) {
+ // set truename to the enclosing JAR
+ truePathname.host = NIL;
+ truePathname.directory = NIL;
+ truePathname.name = NIL;
+ truePathname.type = NIL;
+ truePathname.invalidateNamestring();
+ } else {
+ // XXX There is something fishy in the asymmetry
+ // between the "jar:jar:http:" and "jar:jar:file:"
+ // cases but this currently passes the tests.
+ if (!(truePathname.device.car() instanceof AbstractString)) {
+ truePathname = (Pathname)truePathname.device.car();
+ truePathname.invalidateNamestring();
+ }
+ }
+ thread.bindSpecial(Symbol.LOAD_TRUENAME, truePathname);
+ } else {
+ thread.bindSpecial(Symbol.LOAD_TRUENAME, truename);
+ }
thread.bindSpecial(_SOURCE_,
pathname != null ? pathname : NIL);
if (verbose) {
@@ -538,7 +441,7 @@
out.freshLine();
out._writeString(prefix);
out._writeString(auto ? " Autoloading " : " Loading ");
- out._writeString(truename != null ? truename : "stream");
+ out._writeString(!truename.equals(NIL) ? truePathname.writeToString() : "stream");
out._writeLine(" ...");
out._finishOutput();
LispObject result = loadStream(in, print, thread, returnLastResult);
@@ -546,7 +449,7 @@
out.freshLine();
out._writeString(prefix);
out._writeString(auto ? " Autoloaded " : " Loaded ");
- out._writeString(truename != null ? truename : "stream");
+ out._writeString(!truename.equals(NIL) ? truePathname.writeToString() : "stream");
out._writeString(" (");
out._writeString(String.valueOf(((float)elapsed)/1000));
out._writeLine(" seconds)");
@@ -610,7 +513,6 @@
}
private static final LispObject faslLoadStream(LispThread thread)
-
{
Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
final Environment env = new Environment();
@@ -638,91 +540,36 @@
//whether to return T or the last value.
}
- // Returns extension including leading '.'
- private static final String getExtension(String filename)
- {
- int index = filename.lastIndexOf('.');
- if (index < 0)
- return null;
- if (index < filename.lastIndexOf(File.separatorChar))
- return null; // Last dot was in path part of filename.
- return filename.substring(index);
- }
-
- private static final String getPath(URL url)
- {
- if (url != null) {
- String path;
- try {
- path = URLDecoder.decode(url.getPath(),"UTF-8");
- }
- catch (java.io.UnsupportedEncodingException uee) {
- // Can't happen: every Java is supposed to support
- // at least UTF-8 encoding
- path = null;
- }
- if (path != null) {
- if (Utilities.isPlatformWindows) {
- if (path.length() > 0 && path.charAt(0) == '/')
- path = path.substring(1);
- }
- return path;
- }
- }
- return null;
- }
-
- private static final boolean checkZipFile(File file)
- {
- InputStream in = null;
- try {
- in = new FileInputStream(file);
- byte[] bytes = new byte[4];
- int bytesRead = in.read(bytes);
- return (bytesRead == 4
- && bytes[0] == 0x50
- && bytes[1] == 0x4b
- && bytes[2] == 0x03
- && bytes[3] == 0x04);
- }
- catch (Throwable t) { // any error probably means 'no'
- return false;
- }
- finally {
- if (in != null) {
- try {
- in.close();
- }
- catch (IOException e) {} // ignore exceptions
- }
- }
- }
// ### %load filespec verbose print if-does-not-exist => generalized-boolean
- private static final Primitive _LOAD =
- new Primitive("%load", PACKAGE_SYS, false,
- "filespec verbose print if-does-not-exist")
- {
+ private static final Primitive _LOAD = new _load();
+ private static class _load extends Primitive {
+ _load() {
+ super("%load", PACKAGE_SYS, false,
+ "filespec verbose print if-does-not-exist");
+ }
@Override
public LispObject execute(LispObject filespec, LispObject verbose,
LispObject print, LispObject ifDoesNotExist)
- {
+ {
return load(filespec, verbose, print, ifDoesNotExist, NIL);
}
- };
+ }
// ### %load-returning-last-result filespec verbose print if-does-not-exist => object
- private static final Primitive _LOAD_RETURNING_LAST_RESULT =
- new Primitive("%load-returning-last-result", PACKAGE_SYS, false,
- "filespec verbose print if-does-not-exist")
- {
+ private static final Primitive _LOAD_RETURNING_LAST_RESULT = new _load_returning_last_result();
+ private static class _load_returning_last_result extends Primitive {
+ _load_returning_last_result() {
+ super("%load-returning-last-result", PACKAGE_SYS, false,
+ "filespec verbose print if-does-not-exist");
+ }
@Override
public LispObject execute(LispObject filespec, LispObject verbose,
LispObject print, LispObject ifDoesNotExist)
{
return load(filespec, verbose, print, ifDoesNotExist, T);
}
- };
+ }
private static final LispObject load(LispObject filespec,
LispObject verbose,
@@ -737,11 +584,11 @@
pathname = ((FileStream)filespec).getPathname();
else
pathname = NIL;
- String truename;
+ LispObject truename;
if (pathname instanceof Pathname)
- truename = ((Pathname)pathname).getNamestring();
+ truename = pathname;
else
- truename = null;
+ truename = NIL;
return loadFileFromStream(pathname,
truename,
(Stream) filespec,
@@ -756,7 +603,6 @@
if (pathname instanceof LogicalPathname)
pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
return load(pathname,
- pathname.getNamestring(),
verbose != NIL,
print != NIL,
ifDoesNotExist != NIL,
@@ -764,9 +610,11 @@
}
// ### load-system-file
- private static final Primitive LOAD_SYSTEM_FILE =
- new Primitive("load-system-file", PACKAGE_SYS, true)
- {
+ private static final Primitive LOAD_SYSTEM_FILE = new load_system_file();
+ private static class load_system_file extends Primitive {
+ load_system_file () {
+ super("load-system-file", PACKAGE_SYS, true);
+ }
@Override
public LispObject execute(LispObject arg)
{
@@ -776,7 +624,7 @@
Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
false);
}
- };
+ }
private static class FaslVersionMismatch extends Error
{
Modified: trunk/abcl/src/org/armedbear/lisp/LogicalPathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LogicalPathname.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/LogicalPathname.java Sat Feb 6 05:52:32 2010
@@ -45,10 +45,14 @@
private static final HashMap map = new HashMap();
- public LogicalPathname()
+ protected LogicalPathname()
{
}
+ protected LogicalPathname(Pathname p) {
+ super(p);
+ }
+
public LogicalPathname(String host, String rest)
{
final int limit = rest.length();
@@ -278,28 +282,31 @@
}
// ### canonicalize-logical-host host => canonical-host
- private static final Primitive CANONICALIZE_LOGICAL_HOST =
- new Primitive("canonicalize-logical-host", PACKAGE_SYS, true, "host")
- {
+ private static final Primitive CANONICALIZE_LOGICAL_HOST = new canonicalize_logical_host();
+ private static class canonicalize_logical_host extends Primitive {
+ canonicalize_logical_host() {
+ super("canonicalize-logical-host", PACKAGE_SYS, true, "host");
+ }
@Override
public LispObject execute(LispObject arg)
-
{
- AbstractString s = checkString(arg);
- if (s.length() == 0) {
- // "The null string, "", is not a valid value for any
- // component of a logical pathname." 19.3.2.2
- return error(new LispError("Invalid logical host name: \"" +
- s.getStringValue() + '"'));
- }
- return canonicalizeStringComponent(s);
+ AbstractString s = checkString(arg);
+ if (s.length() == 0) {
+ // "The null string, "", is not a valid value for any
+ // component of a logical pathname." 19.3.2.2
+ return error(new LispError("Invalid logical host name: \"" +
+ s.getStringValue() + '"'));
+ }
+ return canonicalizeStringComponent(s);
}
- };
+ }
// ### %make-logical-pathname namestring => logical-pathname
- private static final Primitive _MAKE_LOGICAL_PATHNAME =
- new Primitive("%make-logical-pathname", PACKAGE_SYS, true, "namestring")
- {
+ private static final Primitive _MAKE_LOGICAL_PATHNAME = new _make_logical_pathname();
+ private static class _make_logical_pathname extends Primitive {
+ _make_logical_pathname() {
+ super("%make-logical-pathname", PACKAGE_SYS, true, "namestring");
+ }
@Override
public LispObject execute(LispObject arg)
@@ -321,5 +328,5 @@
}
return error(new TypeError("Logical namestring does not specify a host: \"" + s + '"'));
}
- };
+ }
}
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 Sat Feb 6 05:52:32 2010
@@ -30,93 +30,169 @@
* obligated to do so. If you do not wish to do so, delete this
* exception statement from your version.
*/
-
package org.armedbear.lisp;
import static org.armedbear.lisp.Lisp.*;
import java.io.File;
import java.io.IOException;
+import java.io.InputStream;
+import java.io.FileInputStream;
+import java.net.JarURLConnection;
+import java.net.MalformedURLException;
import java.net.URL;
+import java.net.URLConnection;
import java.net.URLDecoder;
import java.util.StringTokenizer;
+import java.util.jar.JarEntry;
+import java.util.jar.JarFile;
+import java.util.zip.ZipEntry;
+import java.util.zip.ZipInputStream;
+
+public class Pathname extends LispObject {
-public class Pathname extends LispObject
-{
protected LispObject host = NIL;
protected LispObject device = NIL;
protected LispObject directory = NIL;
protected LispObject name = NIL;
-
// A string, NIL, :WILD or :UNSPECIFIC.
protected LispObject type = NIL;
-
// A positive integer, or NIL, :WILD, :UNSPECIFIC, or :NEWEST.
protected LispObject version = NIL;
private String namestring;
- protected Pathname()
- {
+ /** The protocol for changing any instance field (i.e. 'host', 'type', etc.)
+ * is to call this method after changing the field to recompute the namestring.
+ * We could do this with setter/getters, but that choose not to in order to avoid the
+ * performance indirection penalty.
+ */
+ public void invalidateNamestring() {
+ namestring = null;
+ }
+
+ protected Pathname() {}
+
+ /** Copy constructor which shares no structure with the original. */
+ protected Pathname(Pathname p) {
+ if (p.host != NIL) {
+ if (p.host instanceof SimpleString) {
+ host = new SimpleString(((SimpleString)p.host).getStringValue());
+ } else if (p.host instanceof Symbol) {
+ host = p.host;
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ if (p.device != NIL) {
+ if (p.device instanceof SimpleString) {
+ device = new SimpleString(((SimpleString)p.device).getStringValue());
+ } else if (p.device instanceof Cons) {
+ Cons jars = (Cons)p.device;
+ device = new Cons(NIL, NIL);
+ LispObject first = jars.car();
+ if (first instanceof SimpleString) {
+ ((Cons)device).car = new SimpleString(((SimpleString)first).getStringValue());
+ } else if (first instanceof Pathname) {
+ ((Cons)device).car = new Pathname((Pathname)first);
+ } else {
+ Debug.assertTrue(false);
+ }
+ if (!jars.cdr().equals(NIL)) {
+ if (jars.cdr() instanceof Cons) {
+ ((Cons)device).cdr = new Cons(new Pathname((Pathname)jars.cdr().car()), NIL);
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ } else if (p.device instanceof Symbol) {
+ device = p.device;
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ if (p.directory != NIL) {
+ if (p.directory instanceof Cons) {
+ directory = NIL;
+ for (LispObject list = p.directory; list != NIL; list = list.cdr()) {
+ LispObject o = list.car();
+ if (o instanceof Symbol) {
+ directory = directory.push(o);
+ } else if (o instanceof SimpleString) {
+ directory = directory.push(new SimpleString(((SimpleString)o).getStringValue()));
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ directory.nreverse();
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ if (p.name != NIL) {
+ if (p.name instanceof SimpleString) {
+ name = new SimpleString(((SimpleString)p.name).getStringValue());
+ } else if (p.name instanceof Symbol) {
+ name = p.name;
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
+ if (p.type != NIL) {
+ if (p.type instanceof SimpleString) {
+ type = new SimpleString(((SimpleString)p.type).getStringValue());
+ } else if (p.type instanceof Symbol) {
+ type = p.type;
+ } else {
+ Debug.assertTrue(false);
+ }
+ }
}
- public Pathname(String s)
- {
+ public Pathname(String s) {
init(s);
}
- public Pathname(URL url)
- {
+ public Pathname(URL url) {
String protocol = url.getProtocol();
if ("jar".equals(protocol)) {
- String s;
- try {
- s = URLDecoder.decode(url.getPath(),"UTF-8");
- }
- catch (java.io.UnsupportedEncodingException uee) {
- // Can't happen: every Java is supposed to support
- // at least UTF-8 encoding
- s = null;
- }
- if (s.startsWith("file:")) {
- int index = s.indexOf("!/");
- String container = s.substring(5, index);
- if (Utilities.isPlatformWindows) {
- if (container.length() > 0 && container.charAt(0) == '/')
- container = container.substring(1);
- }
- device = new Pathname(container);
- s = s.substring(index + 1);
- Pathname p = new Pathname(s);
- directory = p.directory;
- name = p.name;
- type = p.type;
- return;
- }
+ init(url.toString());
+ return;
} else if ("file".equals(protocol)) {
String s;
try {
- s = URLDecoder.decode(url.getPath(),"UTF-8");
- }
- catch (java.io.UnsupportedEncodingException uee) {
+ s = URLDecoder.decode(url.getPath(), "UTF-8");
+ } catch (java.io.UnsupportedEncodingException uee) {
// Can't happen: every Java is supposed to support
// at least UTF-8 encoding
+ Debug.assertTrue(false);
s = null;
}
- if (s != null && s.startsWith("file:")) {
- init(s.substring(5));
+ if (s != null) {
+ if (Utilities.isPlatformWindows) {
+ // Workaround for Java's idea of URLs
+ // new (URL"file:///c:/a/b").getPath() --> "/c:/a/b"
+ // whereas we need "c" to be the DEVICE.
+ if (s.length() > 2
+ && s.charAt(0) == '/'
+ && s.charAt(2) == ':') {
+ s = s.substring(1);
+ }
+ }
+ init(s);
return;
}
}
- error(new LispError("Unsupported URL: \"" + url.toString() + '"'));
+ error(new LispError("Unsupported URL: '" + url.toString() + "'"));
}
- private final void init(String s)
- {
- if (s == null)
+ static final private String jarSeparator = "!/";
+ private final void init(String s) {
+ if (s == null) {
return;
- if (s.equals(".") || s.equals("./") ||
- (Utilities.isPlatformWindows && s.equals(".\\"))) {
+ }
+ if (s.equals(".") || s.equals("./")
+ || (Utilities.isPlatformWindows && s.equals(".\\"))) {
directory = new Cons(Keyword.RELATIVE);
return;
}
@@ -126,50 +202,130 @@
}
if (Utilities.isPlatformWindows) {
if (s.startsWith("\\\\")) {
- //UNC path support
- // match \\<server>\<share>\[directories-and-files]
+ //UNC path support
+ // match \\<server>\<share>\[directories-and-files]
- int shareIndex = s.indexOf('\\', 2);
- int dirIndex = s.indexOf('\\', shareIndex + 1);
+ int shareIndex = s.indexOf('\\', 2);
+ int dirIndex = s.indexOf('\\', shareIndex + 1);
- if (shareIndex == -1 || dirIndex == -1)
- error(new LispError("Unsupported UNC path format: \"" + s + '"'));
+ if (shareIndex == -1 || dirIndex == -1) {
+ error(new LispError("Unsupported UNC path format: \"" + s + '"'));
+ }
- host = new SimpleString(s.substring(2, shareIndex));
- device = new SimpleString(s.substring(shareIndex + 1, dirIndex));
-
- Pathname p = new Pathname(s.substring(dirIndex));
- directory = p.directory;
- name = p.name;
- type = p.type;
- version = p.version;
- return;
- }
-
- s = s.replace('/', '\\');
- }
- // Jar file support.
- int bang = s.indexOf("!/");
- if (bang >= 0) {
- Pathname container = new Pathname(s.substring(0, bang));
- LispObject containerType = container.type;
- if (containerType instanceof AbstractString) {
- if (containerType.getStringValue().equalsIgnoreCase("jar")) {
- device = container;
- s = s.substring(bang + 1);
- Pathname p = new Pathname(s);
- directory = p.directory;
- name = p.name;
- type = p.type;
- return;
+ host = new SimpleString(s.substring(2, shareIndex));
+ device = new SimpleString(s.substring(shareIndex + 1, dirIndex));
+
+ Pathname p = new Pathname(s.substring(dirIndex));
+ directory = p.directory;
+ name = p.name;
+ type = p.type;
+ version = p.version;
+ return;
+ }
+ }
+
+ // A JAR file
+ if (s.startsWith("jar:") && s.endsWith(jarSeparator)) {
+ LispObject jars = NIL;
+ int i = s.lastIndexOf(jarSeparator, s.length() - jarSeparator.length() - 1);
+ String jar = null;
+ if (i == -1) {
+ jar = s;
+ } else {
+ // There can be no more than two jar references and the
+ // inner one must be a file reference within the outer.
+ jar = "jar:file:" + s.substring(i + jarSeparator.length());
+ s = s.substring("jar:".length(), i + jarSeparator.length());
+ Pathname p = new Pathname(s);
+ LispObject first = ((Cons) p.device).car();
+ if (first instanceof AbstractString) {
+ jars = jars.push(first);
+ } else {
+ jars = jars.push(p.device.car());
+ }
+ }
+ if (jar.startsWith("jar:file:")) {
+ String jarString = jar.substring("jar:".length(),
+ jar.length() - jarSeparator.length());
+ // Use URL constructor to normalize Windows' use of device
+ URL url = null;
+ try {
+ url = new URL(jarString);
+ } catch (MalformedURLException e) {
+ error(new LispError("Failed to parse '" + jarString + "'"
+ + " as URL:"
+ + e.getMessage()));
+ }
+ Pathname jarPathname = new Pathname(url);
+ if (jarString.endsWith(jarSeparator)) {
+ jars = jars.push(jarPathname.device);
+ } else {
+ jars = jars.push(jarPathname);
}
+ } else {
+ URL url = null;
+ try {
+ url = new URL(jar.substring("jar:".length(), jar.length() - 2));
+ jars = jars.push(new SimpleString(url.toString()));
+ } catch (MalformedURLException e) {
+ error(new LispError("Failed to parse url '" + url + "'"
+ + e.getMessage()));
+ }
+ }
+ jars = jars.nreverse();
+ device = jars;
+ return;
+ }
+
+ // An entry in a JAR file
+ final int separatorIndex = s.lastIndexOf(jarSeparator);
+ if (separatorIndex > 0 && s.startsWith("jar:")) {
+ final String jarURL = s.substring(0, separatorIndex + jarSeparator.length());
+ Pathname d = new Pathname(jarURL);
+ if (device instanceof Cons) {
+ LispObject[] jars = d.copyToArray();
+ // XXX Is this ever reached? If so, need to append lists
+ Debug.assertTrue(false);
+ } else {
+ device = d.device;
+ }
+ s = s.substring(separatorIndex + jarSeparator.length());
+ Pathname p = new Pathname(s);
+ directory = p.directory;
+ name = p.name;
+ type = p.type;
+ version = p.version;
+ return;
+ }
+
+ if (Utilities.isPlatformWindows) {
+ if (!s.contains(jarSeparator)) {
+ s = s.replace("/", "\\");
+ } else {
+ StringBuilder result = new StringBuilder();
+ for (int i = 0; i < s.length(); i++) {
+ char c = s.charAt(i);
+ if ( c != '/') {
+ result.append(c);
+ } else {
+ if (i != 0 && s.charAt(i-1) != '!') {
+ result.append("\\");
+ } else {
+ result.append(c);
+ }
+ }
+ }
+ s = result.toString();
}
}
+
+ // Expand user home directories
if (Utilities.isPlatformUnix) {
- if (s.equals("~"))
+ if (s.equals("~")) {
s = System.getProperty("user.home").concat("/");
- else if (s.startsWith("~/"))
+ } else if (s.startsWith("~/")) {
s = System.getProperty("user.home").concat(s.substring(1));
+ }
}
namestring = s;
if (Utilities.isPlatformWindows) {
@@ -215,56 +371,59 @@
if (index > 0) {
n = s.substring(0, index);
t = s.substring(index + 1);
- } else if (s.length() > 0)
+ } else if (s.length() > 0) {
n = s;
+ }
if (n != null) {
- if (n.equals("*"))
+ if (n.equals("*")) {
name = Keyword.WILD;
- else
+ } else {
name = new SimpleString(n);
+ }
}
if (t != null) {
- if (t.equals("*"))
+ if (t.equals("*")) {
type = Keyword.WILD;
- else
+ } else {
type = new SimpleString(t);
+ }
}
}
- private static final LispObject parseDirectory(String d)
-
- {
- if (d.equals("/") || (Utilities.isPlatformWindows && d.equals("\\")))
+ private static final LispObject parseDirectory(String d) {
+ if (d.equals("/") || (Utilities.isPlatformWindows && d.equals("\\"))) {
return new Cons(Keyword.ABSOLUTE);
+ }
LispObject result;
- if (d.startsWith("/") || (Utilities.isPlatformWindows && d.startsWith("\\")))
+ if (d.startsWith("/") || (Utilities.isPlatformWindows && d.startsWith("\\"))) {
result = new Cons(Keyword.ABSOLUTE);
- else
+ } else {
result = new Cons(Keyword.RELATIVE);
+ }
StringTokenizer st = new StringTokenizer(d, "/\\");
while (st.hasMoreTokens()) {
String token = st.nextToken();
LispObject obj;
- if (token.equals("*"))
+ if (token.equals("*")) {
obj = Keyword.WILD;
- else if (token.equals("**"))
+ } else if (token.equals("**")) {
obj = Keyword.WILD_INFERIORS;
- else if (token.equals("..")) {
+ } else if (token.equals("..")) {
if (result.car() instanceof AbstractString) {
result = result.cdr();
continue;
}
- obj= Keyword.UP;
- } else
+ obj = Keyword.UP;
+ } else {
obj = new SimpleString(token);
+ }
result = new Cons(obj, result);
}
return result.nreverse();
}
@Override
- public LispObject getParts()
- {
+ public LispObject getParts() {
LispObject parts = NIL;
parts = parts.push(new Cons("HOST", host));
parts = parts.push(new Cons("DEVICE", device));
@@ -276,42 +435,41 @@
}
@Override
- public LispObject typeOf()
- {
+ public LispObject typeOf() {
return Symbol.PATHNAME;
}
@Override
- public LispObject classOf()
- {
+ public LispObject classOf() {
return BuiltInClass.PATHNAME;
}
@Override
- public LispObject typep(LispObject type)
- {
- if (type == Symbol.PATHNAME)
+ public LispObject typep(LispObject type) {
+ if (type == Symbol.PATHNAME) {
return T;
- if (type == BuiltInClass.PATHNAME)
+ }
+ if (type == BuiltInClass.PATHNAME) {
return T;
+ }
return super.typep(type);
}
- public final LispObject getDevice()
- {
+ public final LispObject getDevice() {
return device;
}
- public String getNamestring()
- {
- if (namestring != null)
+ public String getNamestring() {
+ if (namestring != null) {
return namestring;
+ }
if (name == NIL && type != NIL) {
Debug.assertTrue(namestring == null);
return null;
}
- if (directory instanceof AbstractString)
+ if (directory instanceof AbstractString) {
Debug.assertTrue(false);
+ }
FastStringBuffer sb = new FastStringBuffer();
// "If a pathname is converted to a namestring, the symbols NIL and
// :UNSPECIFIC cause the field to be treated as if it were empty. That
@@ -319,26 +477,51 @@
// the namestring." 19.2.2.2.3.1
if (host != NIL) {
Debug.assertTrue(host instanceof AbstractString);
- if (! (this instanceof LogicalPathname))
- sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path.
+ if (!(this instanceof LogicalPathname)) {
+ sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path.
+ }
sb.append(host.getStringValue());
- if (this instanceof LogicalPathname)
- sb.append(':');
- else
- sb.append(File.separatorChar);
+ if (this instanceof LogicalPathname) {
+ sb.append(':');
+ } else {
+ sb.append(File.separatorChar);
+ }
}
if (device == NIL) {
} else if (device == Keyword.UNSPECIFIC) {
+ } else if (device instanceof Cons) {
+ LispObject[] jars = ((Cons) device).copyToArray();
+ int i = 0;
+ if (jars[0] instanceof AbstractString) {
+ sb.append("jar:");
+ sb.append(((AbstractString) jars[0]).getStringValue());
+ sb.append("!/");
+ i = 1;
+ }
+ FastStringBuffer prefix = new FastStringBuffer();
+ for (; i < jars.length; i++) {
+ prefix.append("jar:");
+ if (i == 0) {
+ sb.append("file:");
+ }
+ if (jars[i] instanceof Pathname) {
+ sb.append(((Pathname) jars[i]).getNamestring());
+ }
+ sb.append("!/");
+ }
+ sb = prefix.append(sb);
+ } else if (device instanceof AbstractString
+ && device.getStringValue().startsWith("jar:")) {
+ sb.append(device.getStringValue());
} else if (device instanceof AbstractString) {
sb.append(device.getStringValue());
if (this instanceof LogicalPathname
- || host == NIL)
- sb.append(':'); // non-UNC paths
- } else if (device instanceof Pathname) {
- sb.append(((Pathname)device).getNamestring());
- sb.append("!");
- } else
+ || host == NIL) {
+ sb.append(':'); // non-UNC paths
+ }
+ } else {
Debug.assertTrue(false);
+ }
sb.append(getDirectoryNamestring());
if (name instanceof AbstractString) {
String n = name.getStringValue();
@@ -347,8 +530,9 @@
return null;
}
sb.append(n);
- } else if (name == Keyword.WILD)
+ } else if (name == Keyword.WILD) {
sb.append('*');
+ }
if (type != NIL) {
sb.append('.');
if (type instanceof AbstractString) {
@@ -358,19 +542,21 @@
return null;
}
sb.append(t);
- } else if (type == Keyword.WILD)
+ } else if (type == Keyword.WILD) {
sb.append('*');
- else
+ } else {
Debug.assertTrue(false);
+ }
}
if (this instanceof LogicalPathname) {
if (version.integerp()) {
sb.append('.');
int base = Fixnum.getValue(Symbol.PRINT_BASE.symbolValue());
- if (version instanceof Fixnum)
- sb.append(Integer.toString(((Fixnum)version).value, base).toUpperCase());
- else if (version instanceof Bignum)
- sb.append(((Bignum)version).value.toString(base).toUpperCase());
+ if (version instanceof Fixnum) {
+ sb.append(Integer.toString(((Fixnum) version).value, base).toUpperCase());
+ } else if (version instanceof Bignum) {
+ sb.append(((Bignum) version).value.toString(base).toUpperCase());
+ }
} else if (version == Keyword.WILD) {
sb.append(".*");
} else if (version == Keyword.NEWEST) {
@@ -380,8 +566,7 @@
return namestring = sb.toString();
}
- protected String getDirectoryNamestring()
- {
+ protected String getDirectoryNamestring() {
validateDirectory(true);
FastStringBuffer sb = new FastStringBuffer();
// "If a pathname is converted to a namestring, the symbols NIL and
@@ -390,10 +575,11 @@
// the namestring." 19.2.2.2.3.1
if (directory != NIL) {
final char separatorChar;
- if (device instanceof Pathname)
+ if (device instanceof Cons) {
separatorChar = '/'; // Jar file.
- else
+ } else {
separatorChar = File.separatorChar;
+ }
LispObject temp = directory;
LispObject part = temp.car();
temp = temp.cdr();
@@ -407,23 +593,24 @@
}
// else: Nothing to do.
} else {
- error(new FileError("Unsupported directory component " +
- part.writeToString() + ".",
- this));
+ error(new FileError("Unsupported directory component "
+ + part.writeToString() + ".",
+ this));
}
while (temp != NIL) {
part = temp.car();
- if (part instanceof AbstractString)
+ if (part instanceof AbstractString) {
sb.append(part.getStringValue());
- else if (part == Keyword.WILD)
+ } else if (part == Keyword.WILD) {
sb.append('*');
- else if (part == Keyword.WILD_INFERIORS)
+ } else if (part == Keyword.WILD_INFERIORS) {
sb.append("**");
- else if (part == Keyword.UP)
+ } else if (part == Keyword.UP) {
sb.append("..");
- else
+ } else {
error(new FileError("Unsupported directory component " + part.writeToString() + ".",
- this));
+ this));
+ }
sb.append(separatorChar);
temp = temp.cdr();
}
@@ -431,39 +618,71 @@
return sb.toString();
}
+ /** @return The representation of this pathname suitable for referencing an entry in a Zip/JAR file */
+ protected String asEntryPath() {
+ Pathname p = new Pathname();
+ p.directory = directory;
+ p.name = name;
+ p.type = type;
+ String path = p.getNamestring();
+ if (Utilities.isPlatformWindows) {
+ StringBuilder result = new StringBuilder();
+ for (int i = 0; i < path.length(); i++) {
+ char c = path.charAt(i);
+ if (c == '\\') {
+ result.append('/');
+ } else {
+ result.append(c);
+ }
+ }
+ return result.toString();
+ }
+ return path;
+ }
+
@Override
- public boolean equal(LispObject obj)
- {
- if (this == obj)
+ public boolean equal(LispObject obj) {
+ if (this == obj) {
return true;
+ }
if (obj instanceof Pathname) {
Pathname p = (Pathname) obj;
if (Utilities.isPlatformWindows) {
- if (!host.equalp(p.host))
+ if (!host.equalp(p.host)) {
return false;
- if (!device.equalp(p.device))
+ }
+ if (!device.equalp(p.device)) {
return false;
- if (!directory.equalp(p.directory))
+ }
+ if (!directory.equalp(p.directory)) {
return false;
- if (!name.equalp(p.name))
+ }
+ if (!name.equalp(p.name)) {
return false;
- if (!type.equalp(p.type))
+ }
+ if (!type.equalp(p.type)) {
return false;
+ }
// Ignore version component.
//if (!version.equalp(p.version))
// return false;
} else {
// Unix.
- if (!host.equal(p.host))
+ if (!host.equal(p.host)) {
return false;
- if (!device.equal(p.device))
+ }
+ if (!device.equal(p.device)) {
return false;
- if (!directory.equal(p.directory))
+ }
+ if (!directory.equal(p.directory)) {
return false;
- if (!name.equal(p.name))
+ }
+ if (!name.equal(p.name)) {
return false;
- if (!type.equal(p.type))
+ }
+ if (!type.equal(p.type)) {
return false;
+ }
// Ignore version component.
//if (!version.equal(p.version))
// return false;
@@ -474,24 +693,21 @@
}
@Override
- public boolean equalp(LispObject obj)
- {
+ public boolean equalp(LispObject obj) {
return equal(obj);
}
@Override
- public int sxhash()
- {
- return ((host.sxhash() ^
- device.sxhash() ^
- directory.sxhash() ^
- name.sxhash() ^
- type.sxhash()) & 0x7fffffff);
+ public int sxhash() {
+ return ((host.sxhash()
+ ^ device.sxhash()
+ ^ directory.sxhash()
+ ^ name.sxhash()
+ ^ type.sxhash()) & 0x7fffffff);
}
@Override
- public String writeToString()
- {
+ public String writeToString() {
final LispThread thread = LispThread.currentThread();
boolean printReadably = (Symbol.PRINT_READABLY.symbolValue(thread) != NIL);
boolean printEscape = (Symbol.PRINT_ESCAPE.symbolValue(thread) != NIL);
@@ -507,47 +723,52 @@
useNamestring = false;
} else if (name instanceof AbstractString) {
String n = name.getStringValue();
- if (n.equals(".") || n.equals(".."))
+ if (n.equals(".") || n.equals("..")) {
useNamestring = false;
- else if (n.indexOf(File.separatorChar) >= 0)
+ } else if (n.indexOf(File.separatorChar) >= 0) {
useNamestring = false;
+ }
}
}
- } else
- useNamestring = false;
+ } else {
+ useNamestring = false;
+ }
FastStringBuffer sb = new FastStringBuffer();
if (useNamestring) {
- if (printReadably || printEscape)
+ if (printReadably || printEscape) {
sb.append("#P\"");
+ }
final int limit = s.length();
for (int i = 0; i < limit; i++) {
char c = s.charAt(i);
if (printReadably || printEscape) {
- if (c == '\"' || c == '\\')
+ if (c == '\"' || c == '\\') {
sb.append('\\');
+ }
}
sb.append(c);
}
- if (printReadably || printEscape)
+ if (printReadably || printEscape) {
sb.append('"');
+ }
} else {
sb.append("#P(");
if (host != NIL) {
sb.append(":HOST ");
sb.append(host.writeToString());
sb.append(' ');
- }
- if (device != NIL) {
- sb.append(":DEVICE ");
- sb.append(device.writeToString());
- sb.append(' ');
+ }
+ if (device != NIL) {
+ sb.append(":DEVICE ");
+ sb.append(device.writeToString());
+ sb.append(' ');
}
if (directory != NIL) {
sb.append(":DIRECTORY ");
sb.append(directory.writeToString());
sb.append(" ");
}
- if (name != NIL) {
+ if (name != NIL) {
sb.append(":NAME ");
sb.append(name.writeToString());
sb.append(' ');
@@ -562,31 +783,26 @@
sb.append(version.writeToString());
sb.append(' ');
}
- if (sb.charAt(sb.length() - 1) == ' ')
+ if (sb.charAt(sb.length() - 1) == ' ') {
sb.setLength(sb.length() - 1);
+ }
sb.append(')');
- }
- return sb.toString();
+ }
+ return sb.toString();
}
-
// A logical host is represented as the string that names it.
// (defvar *logical-pathname-translations* (make-hash-table :test 'equal))
public static EqualHashTable LOGICAL_PATHNAME_TRANSLATIONS =
- new EqualHashTable(64, NIL, NIL);
-
+ new EqualHashTable(64, NIL, NIL);
private static final Symbol _LOGICAL_PATHNAME_TRANSLATIONS_ =
- exportSpecial("*LOGICAL-PATHNAME-TRANSLATIONS*", PACKAGE_SYS,
- LOGICAL_PATHNAME_TRANSLATIONS);
-
- public static Pathname parseNamestring(String s)
+ exportSpecial("*LOGICAL-PATHNAME-TRANSLATIONS*", PACKAGE_SYS,
+ LOGICAL_PATHNAME_TRANSLATIONS);
- {
+ public static Pathname parseNamestring(String s) {
return new Pathname(s);
}
- public static Pathname parseNamestring(AbstractString namestring)
-
- {
+ public static Pathname parseNamestring(AbstractString namestring) {
// Check for a logical pathname host.
String s = namestring.getStringValue();
String h = getHostString(s);
@@ -598,17 +814,15 @@
}
public static Pathname parseNamestring(AbstractString namestring,
- AbstractString host)
-
- {
+ AbstractString host) {
// Look for a logical pathname host in the namestring.
String s = namestring.getStringValue();
String h = getHostString(s);
if (h != null) {
if (!h.equals(host.getStringValue())) {
- error(new LispError("Host in " + s +
- " does not match requested host " +
- host.getStringValue()));
+ error(new LispError("Host in " + s
+ + " does not match requested host "
+ + host.getStringValue()));
// Not reached.
return null;
}
@@ -625,149 +839,142 @@
}
// "one or more uppercase letters, digits, and hyphens"
- protected static String getHostString(String s)
- {
+ protected static String getHostString(String s) {
int colon = s.indexOf(':');
- if (colon >= 0)
+ if (colon >= 0) {
return s.substring(0, colon).toUpperCase();
- else
+ } else {
return null;
+ }
}
- private static final void checkCaseArgument(LispObject arg)
-
- {
- if (arg != Keyword.COMMON && arg != Keyword.LOCAL)
+ private static final void checkCaseArgument(LispObject arg) {
+ if (arg != Keyword.COMMON && arg != Keyword.LOCAL) {
type_error(arg, list(Symbol.MEMBER, Keyword.COMMON,
- Keyword.LOCAL));
+ Keyword.LOCAL));
+ }
}
-
// ### %pathname-host
- private static final Primitive _PATHNAME_HOST =
- new Primitive("%pathname-host", PACKAGE_SYS, false)
- {
+ private static final Primitive _PATHNAME_HOST = new _pathname_host();
+ private static class _pathname_host extends Primitive {
+ _pathname_host() {
+ super("%pathname-host", PACKAGE_SYS, false);
+ }
@Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
+ public LispObject execute(LispObject first, LispObject second) {
checkCaseArgument(second);
return coerceToPathname(first).host;
}
- };
-
+ }
// ### %pathname-device
- private static final Primitive _PATHNAME_DEVICE =
- new Primitive("%pathname-device", PACKAGE_SYS, false)
- {
+ private static final Primitive _PATHNAME_DEVICE = new _pathname_device();
+ private static class _pathname_device extends Primitive {
+ _pathname_device() {
+ super("%pathname-device", PACKAGE_SYS, false);
+ }
@Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
+ public LispObject execute(LispObject first, LispObject second) {
checkCaseArgument(second);
return coerceToPathname(first).device;
}
- };
-
+ }
// ### %pathname-directory
- private static final Primitive _PATHNAME_DIRECTORY =
- new Primitive("%pathname-directory", PACKAGE_SYS, false)
- {
+ private static final Primitive _PATHNAME_DIRECTORY = new _pathname_directory();
+ private static class _pathname_directory extends Primitive {
+ _pathname_directory() {
+ super("%pathname-directory", PACKAGE_SYS, false);
+ }
@Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
+ public LispObject execute(LispObject first, LispObject second) {
checkCaseArgument(second);
return coerceToPathname(first).directory;
}
- };
-
+ }
// ### %pathname-name
- private static final Primitive _PATHNAME_NAME =
- new Primitive("%pathname-name", PACKAGE_SYS, false)
- {
+ private static final Primitive _PATHNAME_NAME = new _pathname_name();
+ private static class _pathname_name extends Primitive {
+ _pathname_name() {
+ super ("%pathname-name", PACKAGE_SYS, false);
+ }
@Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
+ public LispObject execute(LispObject first, LispObject second) {
checkCaseArgument(second);
return coerceToPathname(first).name;
}
- };
-
+ }
// ### %pathname-type
- private static final Primitive _PATHNAME_TYPE =
- new Primitive("%pathname-type", PACKAGE_SYS, false)
- {
+ private static final Primitive _PATHNAME_TYPE = new _pathname_type();
+ private static class _pathname_type extends Primitive {
+ _pathname_type() {
+ super("%pathname-type", PACKAGE_SYS, false);
+ }
@Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
+ public LispObject execute(LispObject first, LispObject second) {
checkCaseArgument(second);
return coerceToPathname(first).type;
}
- };
-
+ }
// ### pathname-version
- private static final Primitive PATHNAME_VERSION =
- new Primitive("pathname-version", "pathname")
- {
+ private static final Primitive PATHNAME_VERSION = new pathname_version();
+ private static class pathname_version extends Primitive {
+ pathname_version() {
+ super("pathname-version", "pathname");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
return coerceToPathname(arg).version;
}
- };
-
+ }
// ### namestring
// namestring pathname => namestring
- private static final Primitive NAMESTRING =
- new Primitive("namestring", "pathname")
- {
+ private static final Primitive NAMESTRING = new namestring();
+ private static class namestring extends Primitive {
+ namestring() {
+ super("namestring", "pathname");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
Pathname pathname = coerceToPathname(arg);
String namestring = pathname.getNamestring();
- if (namestring == null)
- error(new SimpleError("Pathname has no namestring: " +
- pathname.writeToString()));
+ if (namestring == null) {
+ error(new SimpleError("Pathname has no namestring: "
+ + pathname.writeToString()));
+ }
return new SimpleString(namestring);
}
- };
-
+ }
// ### directory-namestring
// directory-namestring pathname => namestring
- private static final Primitive DIRECTORY_NAMESTRING =
- new Primitive("directory-namestring", "pathname")
- {
+ private static final Primitive DIRECTORY_NAMESTRING = new directory_namestring();
+ private static class directory_namestring extends Primitive {
+ directory_namestring() {
+ super("directory-namestring", "pathname");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
return new SimpleString(coerceToPathname(arg).getDirectoryNamestring());
}
- };
-
+ }
// ### pathname pathspec => pathname
- private static final Primitive PATHNAME =
- new Primitive("pathname", "pathspec")
- {
+ private static final Primitive PATHNAME = new pathname();
+ private static class pathname extends Primitive {
+ pathname() {
+ super("pathname", "pathspec");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
return coerceToPathname(arg);
}
- };
-
+ }
// ### %parse-namestring string host default-pathname => pathname, position
- private static final Primitive _PARSE_NAMESTRING =
- new Primitive("%parse-namestring", PACKAGE_SYS, false,
- "namestring host default-pathname")
- {
+ private static final Primitive _PARSE_NAMESTRING = new _parse_namestring();
+ private static class _parse_namestring extends Primitive {
+ _parse_namestring() {
+ super("%parse-namestring", PACKAGE_SYS, false,
+ "namestring host default-pathname");
+ }
@Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
-
- {
+ public LispObject execute(LispObject first, LispObject second, LispObject third) {
final LispThread thread = LispThread.currentThread();
final AbstractString namestring = checkString(first);
// The HOST parameter must be a string or NIL.
@@ -778,44 +985,53 @@
// pathname namestring on the host that is the host component
// of DEFAULT-PATHNAME."
third = coerceToPathname(third);
- if (third instanceof LogicalPathname)
- second = ((LogicalPathname)third).host;
- else
+ if (third instanceof LogicalPathname) {
+ second = ((LogicalPathname) third).host;
+ } else {
return thread.setValues(parseNamestring(namestring),
namestring.LENGTH());
+ }
}
Debug.assertTrue(second != NIL);
final AbstractString host = checkString(second);
return thread.setValues(parseNamestring(namestring, host),
namestring.LENGTH());
}
- };
-
+ }
// ### make-pathname
- private static final Primitive MAKE_PATHNAME =
- new Primitive("make-pathname",
- "&key host device directory name type version defaults case")
- {
+ private static final Primitive MAKE_PATHNAME = new make_pathname();
+ private static class make_pathname extends Primitive {
+ make_pathname() {
+ super("make-pathname",
+ "&key host device directory name type version defaults case");
+ }
@Override
- public LispObject execute(LispObject[] args)
-
- {
+ public LispObject execute(LispObject[] args) {
return _makePathname(args);
}
- };
+ }
// Used by the #p reader.
- public static final Pathname makePathname(LispObject args)
-
- {
+ public static final Pathname makePathname(LispObject args) {
return _makePathname(args.copyToArray());
}
- private static final Pathname _makePathname(LispObject[] args)
+ public static final Pathname makePathname(File file) {
+ String namestring = null;
+ try {
+ namestring = file.getCanonicalPath();
+ } catch (IOException e) {
+ Debug.trace("Failed to make a Pathname from "
+ + "." + file + "'");
+ return null;
+ }
+ return new Pathname(namestring);
+ }
- {
- if (args.length % 2 != 0)
+ private static final Pathname _makePathname(LispObject[] args) {
+ if (args.length % 2 != 0) {
error(new ProgramError("Odd number of keyword arguments."));
+ }
LispObject host = NIL;
LispObject device = NIL;
LispObject directory = NIL;
@@ -828,19 +1044,20 @@
boolean typeSupplied = false;
for (int i = 0; i < args.length; i += 2) {
LispObject key = args[i];
- LispObject value = args[i+1];
+ LispObject value = args[i + 1];
if (key == Keyword.HOST) {
host = value;
} else if (key == Keyword.DEVICE) {
device = value;
deviceSupplied = true;
} else if (key == Keyword.DIRECTORY) {
- if (value instanceof AbstractString)
+ if (value instanceof AbstractString) {
directory = list(Keyword.ABSOLUTE, value);
- else if (value == Keyword.WILD)
+ } else if (value == Keyword.WILD) {
directory = list(Keyword.ABSOLUTE, Keyword.WILD);
- else
+ } else {
directory = value;
+ }
} else if (key == Keyword.NAME) {
name = value;
nameSupplied = true;
@@ -852,25 +1069,30 @@
} else if (key == Keyword.DEFAULTS) {
defaults = coerceToPathname(value);
} else if (key == Keyword.CASE) {
- // Ignored.
+ // Ignored.
}
}
if (defaults != null) {
- if (host == NIL)
+ if (host == NIL) {
host = defaults.host;
+ }
directory = mergeDirectories(directory, defaults.directory);
- if (!deviceSupplied)
+ if (!deviceSupplied) {
device = defaults.device;
- if (!nameSupplied)
+ }
+ if (!nameSupplied) {
name = defaults.name;
- if (!typeSupplied)
+ }
+ if (!typeSupplied) {
type = defaults.type;
+ }
}
final Pathname p;
final boolean logical;
if (host != NIL) {
- if (host instanceof AbstractString)
- host = LogicalPathname.canonicalizeStringComponent((AbstractString)host);
+ if (host instanceof AbstractString) {
+ host = LogicalPathname.canonicalizeStringComponent((AbstractString) host);
+ }
if (LOGICAL_PATHNAME_TRANSLATIONS.get(host) == null) {
// Not a defined logical pathname host.
error(new LispError(host.writeToString() + " is not defined as a logical pathname host."));
@@ -886,10 +1108,12 @@
if (device != NIL) {
if (logical) {
// "The device component of a logical pathname is always :UNSPECIFIC."
- if (device != Keyword.UNSPECIFIC)
+ if (device != Keyword.UNSPECIFIC) {
error(new LispError("The device component of a logical pathname must be :UNSPECIFIC."));
- } else
+ }
+ } else {
p.device = device;
+ }
}
if (directory != NIL) {
if (logical) {
@@ -897,48 +1121,51 @@
LispObject d = NIL;
while (directory != NIL) {
LispObject component = directory.car();
- if (component instanceof AbstractString)
- d = d.push(LogicalPathname.canonicalizeStringComponent((AbstractString)component));
- else
+ if (component instanceof AbstractString) {
+ d = d.push(LogicalPathname.canonicalizeStringComponent((AbstractString) component));
+ } else {
d = d.push(component);
+ }
directory = directory.cdr();
}
p.directory = d.nreverse();
- } else if (directory == Keyword.WILD || directory == Keyword.WILD_INFERIORS)
+ } else if (directory == Keyword.WILD || directory == Keyword.WILD_INFERIORS) {
p.directory = directory;
- else
+ } else {
error(new LispError("Invalid directory component for logical pathname: " + directory.writeToString()));
- } else
+ }
+ } else {
p.directory = directory;
+ }
}
if (name != NIL) {
- if (logical && name instanceof AbstractString)
- p.name = LogicalPathname.canonicalizeStringComponent((AbstractString)name);
- else if (name instanceof AbstractString)
- p.name = validateStringComponent((AbstractString)name);
- else
+ if (logical && name instanceof AbstractString) {
+ p.name = LogicalPathname.canonicalizeStringComponent((AbstractString) name);
+ } else if (name instanceof AbstractString) {
+ p.name = validateStringComponent((AbstractString) name);
+ } else {
p.name = name;
+ }
}
if (type != NIL) {
- if (logical && type instanceof AbstractString)
- p.type = LogicalPathname.canonicalizeStringComponent((AbstractString)type);
- else
+ if (logical && type instanceof AbstractString) {
+ p.type = LogicalPathname.canonicalizeStringComponent((AbstractString) type);
+ } else {
p.type = type;
+ }
}
p.version = version;
return p;
}
- private static final AbstractString validateStringComponent(AbstractString s)
-
- {
+ private static final AbstractString validateStringComponent(AbstractString s) {
final int limit = s.length();
for (int i = 0; i < limit; i++) {
char c = s.charAt(i);
if (c == '/' || c == '\\' && Utilities.isPlatformWindows) {
- error(new LispError("Invalid character #\\" + c +
- " in pathname component \"" + s +
- '"'));
+ error(new LispError("Invalid character #\\" + c
+ + " in pathname component \"" + s
+ + '"'));
// Not reached.
return null;
}
@@ -946,9 +1173,7 @@
return s;
}
- private final boolean validateDirectory(boolean signalError)
-
- {
+ private final boolean validateDirectory(boolean signalError) {
LispObject temp = directory;
while (temp != NIL) {
LispObject first = temp.car();
@@ -970,259 +1195,348 @@
}
return true;
}
-
// ### pathnamep
- private static final Primitive PATHNAMEP =
- new Primitive("pathnamep", "object")
- {
+ private static final Primitive PATHNAMEP = new pathnamep();
+ private static class pathnamep extends Primitive {
+ pathnamep() {
+ super("pathnamep", "object");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
return arg instanceof Pathname ? T : NIL;
}
- };
-
+ }
// ### logical-pathname-p
- private static final Primitive LOGICAL_PATHNAME_P =
- new Primitive("logical-pathname-p", PACKAGE_SYS, true, "object")
- {
+ private static final Primitive LOGICAL_PATHNAME_P = new logical_pathname_p();
+ private static class logical_pathname_p extends Primitive {
+ logical_pathname_p() {
+ super("logical-pathname-p", PACKAGE_SYS, true, "object");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
return arg instanceof LogicalPathname ? T : NIL;
}
- };
-
+ }
// ### user-homedir-pathname &optional host => pathname
- private static final Primitive USER_HOMEDIR_PATHNAME =
- new Primitive("user-homedir-pathname", "&optional host")
- {
+ private static final Primitive USER_HOMEDIR_PATHNAME = new user_homedir_pathname();
+ private static class user_homedir_pathname extends Primitive {
+ user_homedir_pathname() {
+ super("user-homedir-pathname", "&optional host");
+ }
@Override
- public LispObject execute(LispObject[] args)
- {
+ public LispObject execute(LispObject[] args) {
switch (args.length) {
- case 0: {
- String s = System.getProperty("user.home");
- if (!s.endsWith(File.separator))
- s = s.concat(File.separator);
- return new Pathname(s);
- }
- case 1:
- return NIL;
- default:
- return error(new WrongNumberOfArgumentsException(this));
- }
- }
- };
-
- // ### list-directory
- private static final Primitive LIST_DIRECTORY =
- new Primitive("list-directory", PACKAGE_SYS, true)
- {
+ case 0: {
+ String s = System.getProperty("user.home");
+ if (!s.endsWith(File.separator)) {
+ s = s.concat(File.separator);
+ }
+ return new Pathname(s);
+ }
+ case 1:
+ return NIL; // ??? huh? -- ME 20100206
+ default:
+ return error(new WrongNumberOfArgumentsException(this));
+ }
+ }
+ }
+ // ### list-directory directory
+ private static final Primitive LIST_DIRECTORY = new list_directory();
+ private static class list_directory extends Primitive {
+ list_directory() {
+ super("list-directory", PACKAGE_SYS, true, "directory");
+ }
@Override
- public LispObject execute(LispObject arg)
- {
+ public LispObject execute(LispObject arg) {
Pathname pathname = coerceToPathname(arg);
- if (pathname instanceof LogicalPathname)
- pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
+ if (pathname instanceof LogicalPathname) {
+ pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
+ }
+ if (pathname.isJar()) {
+ return error(new FileError("Unimplemented directory listing of JAR files.", pathname));
+ }
LispObject result = NIL;
String s = pathname.getNamestring();
if (s != null) {
File f = new File(s);
if (f.isDirectory()) {
try {
- File[] files = f.listFiles();
+ File[] files = f.listFiles();
for (int i = files.length; i-- > 0;) {
File file = files[i];
Pathname p;
- if (file.isDirectory())
+ if (file.isDirectory()) {
p = Utilities.getDirectoryPathname(file);
- else
+ } else {
p = new Pathname(file.getCanonicalPath());
+ }
result = new Cons(p, result);
}
- }
- catch (IOException e) {
+ } catch (IOException e) {
return error(new FileError("Unable to list directory " + pathname.writeToString() + ".",
pathname));
- }
- catch (SecurityException e) {
- }
- catch (NullPointerException e) {
+ } catch (SecurityException e) {
+ Debug.trace(e);
+ } catch (NullPointerException e) {
+ Debug.trace(e);
}
}
}
return result;
}
- };
+ }
- public boolean isWild()
- {
- if (host == Keyword.WILD || host == Keyword.WILD_INFERIORS)
+ public boolean isAbsolute() {
+ if (!directory.equals(NIL) || !(directory == null)) {
+ if (directory instanceof Cons) {
+ if (((Cons)directory).car().equals(Keyword.ABSOLUTE)) {
+ return true;
+ }
+ }
+ }
+ return false;
+ }
+
+ // ### PATHNAME-JAR-P
+ private static final Primitive PATHNAME_JAR_P = new pathname_jar_p();
+ private static class pathname_jar_p extends Primitive {
+ pathname_jar_p() {
+ super("pathname-jar-p", PACKAGE_SYS, true, "pathname",
+ "Predicate for whether PATHNAME references a JAR.");
+ }
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname p = coerceToPathname(arg);
+ return p.isJar() ? T : NIL;
+ }
+ }
+
+ public boolean isJar() {
+ if (device instanceof Cons) {
+ return true;
+ }
+ return false;
+ }
+
+ public boolean isWild() {
+ if (host == Keyword.WILD || host == Keyword.WILD_INFERIORS) {
return true;
- if (device == Keyword.WILD || device == Keyword.WILD_INFERIORS)
+ }
+ if (device == Keyword.WILD || device == Keyword.WILD_INFERIORS) {
return true;
+ }
if (directory instanceof Cons) {
- if (memq(Keyword.WILD, directory))
+ if (memq(Keyword.WILD, directory)) {
return true;
- if (memq(Keyword.WILD_INFERIORS, directory))
+ }
+ if (memq(Keyword.WILD_INFERIORS, directory)) {
return true;
+ }
}
- if (name == Keyword.WILD || name == Keyword.WILD_INFERIORS)
+ if (name == Keyword.WILD || name == Keyword.WILD_INFERIORS) {
return true;
- if (type == Keyword.WILD || type == Keyword.WILD_INFERIORS)
+ }
+ if (type == Keyword.WILD || type == Keyword.WILD_INFERIORS) {
return true;
- if (version == Keyword.WILD || version == Keyword.WILD_INFERIORS)
+ }
+ if (version == Keyword.WILD || version == Keyword.WILD_INFERIORS) {
return true;
+ }
return false;
}
-
// ### %wild-pathname-p
private static final Primitive _WILD_PATHNAME_P =
- new Primitive("%wild-pathname-p", PACKAGE_SYS, true)
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- Pathname pathname = coerceToPathname(first);
- if (second == NIL)
- return pathname.isWild() ? T : NIL;
- if (second == Keyword.DIRECTORY) {
- if (pathname.directory instanceof Cons) {
- if (memq(Keyword.WILD, pathname.directory))
- return T;
- if (memq(Keyword.WILD_INFERIORS, pathname.directory))
- return T;
- }
- return NIL;
- }
- LispObject value;
- if (second == Keyword.HOST)
- value = pathname.host;
- else if (second == Keyword.DEVICE)
- value = pathname.device;
- else if (second == Keyword.NAME)
- value = pathname.name;
- else if (second == Keyword.TYPE)
- value = pathname.type;
- else if (second == Keyword.VERSION)
- value = pathname.version;
- else
- return error(new ProgramError("Unrecognized keyword " +
- second.writeToString() + "."));
- if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS)
- return T;
- else
- return NIL;
- }
- };
+ new Primitive("%wild-pathname-p", PACKAGE_SYS, true) {
+ @Override
+ public LispObject execute(LispObject first, LispObject second) {
+ Pathname pathname = coerceToPathname(first);
+ if (second == NIL) {
+ return pathname.isWild() ? T : NIL;
+ }
+ if (second == Keyword.DIRECTORY) {
+ if (pathname.directory instanceof Cons) {
+ if (memq(Keyword.WILD, pathname.directory)) {
+ return T;
+ }
+ if (memq(Keyword.WILD_INFERIORS, pathname.directory)) {
+ return T;
+ }
+ }
+ return NIL;
+ }
+ LispObject value;
+ if (second == Keyword.HOST) {
+ value = pathname.host;
+ } else if (second == Keyword.DEVICE) {
+ value = pathname.device;
+ } else if (second == Keyword.NAME) {
+ value = pathname.name;
+ } else if (second == Keyword.TYPE) {
+ value = pathname.type;
+ } else if (second == Keyword.VERSION) {
+ value = pathname.version;
+ } else {
+ return error(new ProgramError("Unrecognized keyword "
+ + second.writeToString() + "."));
+ }
+ if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS) {
+ return T;
+ } else {
+ return NIL;
+ }
+ }
+ };
// ### merge-pathnames
private static final Primitive MERGE_PATHNAMES =
- new Primitive("merge-pathnames",
- "pathname &optional default-pathname default-version")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- Pathname pathname = coerceToPathname(arg);
- Pathname defaultPathname =
+ new Primitive("merge-pathnames",
+ "pathname &optional default-pathname default-version") {
+
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname pathname = coerceToPathname(arg);
+ Pathname defaultPathname =
coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
- LispObject defaultVersion = Keyword.NEWEST;
- return mergePathnames(pathname, defaultPathname, defaultVersion);
+ LispObject defaultVersion = Keyword.NEWEST;
+ return mergePathnames(pathname, defaultPathname, defaultVersion);
+ }
+
+ @Override
+ public LispObject execute(LispObject first, LispObject second) {
+ Pathname pathname = coerceToPathname(first);
+ Pathname defaultPathname =
+ coerceToPathname(second);
+ LispObject defaultVersion = Keyword.NEWEST;
+ return mergePathnames(pathname, defaultPathname, defaultVersion);
+ }
+
+ @Override
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third) {
+ Pathname pathname = coerceToPathname(first);
+ Pathname defaultPathname =
+ coerceToPathname(second);
+ LispObject defaultVersion = third;
+ return mergePathnames(pathname, defaultPathname, defaultVersion);
+ }
+ };
+
+ public static final Pathname mergePathnames(Pathname pathname, Pathname defaultPathname) {
+ return mergePathnames(pathname, defaultPathname, Keyword.NEWEST);
+ }
+
+ public static final Pathname mergePathnames(final Pathname pathname,
+ final Pathname defaultPathname,
+ final LispObject defaultVersion)
+ {
+ Pathname result;
+ Pathname p = new Pathname(pathname);
+ Pathname d;
+
+ if (pathname instanceof LogicalPathname) {
+ result = new LogicalPathname();
+ d = new Pathname(defaultPathname);
+ } else {
+ result = new Pathname();
+ if (defaultPathname instanceof LogicalPathname) {
+ d = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname);
+ } else {
+ d = new Pathname(defaultPathname);
+ }
+ }
+ if (pathname.host != NIL) {
+ result.host = p.host;
+ } else {
+ result.host = d.host;
}
- @Override
- public LispObject execute(LispObject first, LispObject second)
- {
- Pathname pathname = coerceToPathname(first);
- Pathname defaultPathname =
- coerceToPathname(second);
- LispObject defaultVersion = Keyword.NEWEST;
- return mergePathnames(pathname, defaultPathname, defaultVersion);
+ if (pathname.device != NIL) { // XXX if device represent JARs we want to merge
+ result.device = p.device;
+ } else {
+ result.device = d.device;
}
- @Override
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
- {
- Pathname pathname = coerceToPathname(first);
- Pathname defaultPathname =
- coerceToPathname(second);
- LispObject defaultVersion = third;
- return mergePathnames(pathname, defaultPathname, defaultVersion);
+ if (pathname.isJar()) {
+ Cons jars = (Cons)result.device;
+ LispObject jar = jars.car;
+ if (jar instanceof Pathname) {
+ Pathname defaults = new Pathname(d);
+ if (defaults.isJar()) {
+ defaults.device = NIL;
+ }
+ Pathname o = mergePathnames((Pathname)jar, defaults);
+ if (o.directory instanceof Cons
+ && ((Cons)o.directory).length() == 1) { // i.e. (:ABSOLUTE) or (:RELATIVE)
+ o.directory = NIL;
+ }
+ ((Cons)result.device).car = o;
+ }
+ } else {
+ result.directory = mergeDirectories(p.directory, d.directory);
}
- };
- public static final Pathname mergePathnames(Pathname pathname,
- Pathname defaultPathname,
- LispObject defaultVersion)
+ // A JAR always has relative directories
+ if (result.isJar()
+ && result.directory instanceof Cons
+ && result.directory.car().equals(Keyword.ABSOLUTE)) {
+ if (result.directory.cdr().equals(NIL)) {
+ result.directory = NIL;
+ } else {
+ ((Cons)result.directory).car = Keyword.RELATIVE;
+ }
+ }
- {
- Pathname p;
- if (pathname instanceof LogicalPathname)
- p = new LogicalPathname();
- else {
- p = new Pathname();
- if (defaultPathname instanceof LogicalPathname)
- defaultPathname = LogicalPathname.translateLogicalPathname((LogicalPathname)defaultPathname);
+ if (pathname.name != NIL) {
+ result.name = p.name;
+ } else {
+ result.name = d.name;
}
- if (pathname.host != NIL)
- p.host = pathname.host;
- else
- p.host = defaultPathname.host;
- if (pathname.device != NIL)
- p.device = pathname.device;
- else
- p.device = defaultPathname.device;
- p.directory =
- mergeDirectories(pathname.directory, defaultPathname.directory);
- if (pathname.name != NIL)
- p.name = pathname.name;
- else
- p.name = defaultPathname.name;
- if (pathname.type != NIL)
- p.type = pathname.type;
- else
- p.type = defaultPathname.type;
- if (pathname.version != NIL)
- p.version = pathname.version;
- else if (pathname.name instanceof AbstractString)
- p.version = defaultVersion;
- else if (defaultPathname.version != NIL)
- p.version = defaultPathname.version;
- else
- p.version = defaultVersion;
- if (p instanceof LogicalPathname) {
+ if (pathname.type != NIL) {
+ result.type = p.type;
+ } else {
+ result.type = d.type;
+ }
+ if (pathname.version != NIL) {
+ result.version = pathname.version;
+ } else if (pathname.name instanceof AbstractString) {
+ result.version = defaultVersion;
+ } else if (defaultPathname.version != NIL) {
+ result.version = defaultPathname.version;
+ } else {
+ result.version = defaultVersion;
+ }
+ if (pathname instanceof LogicalPathname) {
// When we're returning a logical
- p.device = Keyword.UNSPECIFIC;
- if (p.directory.listp()) {
- LispObject original = p.directory;
+ result.device = Keyword.UNSPECIFIC;
+ if (result.directory.listp()) {
+ LispObject original = result.directory;
LispObject canonical = NIL;
while (original != NIL) {
LispObject component = original.car();
- if (component instanceof AbstractString)
- component = LogicalPathname.canonicalizeStringComponent((AbstractString)component);
+ if (component instanceof AbstractString) {
+ component = LogicalPathname.canonicalizeStringComponent((AbstractString) component);
+ }
canonical = canonical.push(component);
original = original.cdr();
}
- p.directory = canonical.nreverse();
+ result.directory = canonical.nreverse();
+ }
+ if (result.name instanceof AbstractString) {
+ result.name = LogicalPathname.canonicalizeStringComponent((AbstractString) result.name);
+ }
+ if (result.type instanceof AbstractString) {
+ result.type = LogicalPathname.canonicalizeStringComponent((AbstractString) result.type);
}
- if (p.name instanceof AbstractString)
- p.name = LogicalPathname.canonicalizeStringComponent((AbstractString)p.name);
- if (p.type instanceof AbstractString)
- p.type = LogicalPathname.canonicalizeStringComponent((AbstractString)p.type);
}
- return p;
+ result.invalidateNamestring();
+ return result;
}
private static final LispObject mergeDirectories(LispObject dir,
- LispObject defaultDir)
-
- {
- if (dir == NIL)
+ LispObject defaultDir) {
+ if (dir == NIL) {
return defaultDir;
+ }
if (dir.car() == Keyword.RELATIVE && defaultDir != NIL) {
LispObject result = NIL;
while (defaultDir != NIL) {
@@ -1237,154 +1551,446 @@
LispObject[] array = result.copyToArray();
for (int i = 0; i < array.length - 1; i++) {
if (array[i] == Keyword.BACK) {
- if (array[i+1] instanceof AbstractString || array[i+1] == Keyword.WILD) {
+ if (array[i + 1] instanceof AbstractString || array[i + 1] == Keyword.WILD) {
array[i] = null;
- array[i+1] = null;
+ array[i + 1] = null;
}
}
}
result = NIL;
for (int i = 0; i < array.length; i++) {
- if (array[i] != null)
+ if (array[i] != null) {
result = new Cons(array[i], result);
+ }
}
return result;
}
return dir;
}
- public static final LispObject truename(LispObject arg,
- boolean errorIfDoesNotExist)
+ public static final LispObject truename(Pathname pathname) {
+ return truename(pathname, false);
+ }
+
+ public static final LispObject truename(LispObject arg) {
+ return truename(arg, false);
+ }
+ public static final LispObject truename(LispObject arg, boolean errorIfDoesNotExist) {
+ final Pathname pathname = coerceToPathname(arg);
+ return truename(pathname, errorIfDoesNotExist);
+ }
+
+ /** @return The canonical TRUENAME as a Pathname if the pathname
+ * exists, otherwise returns NIL or possibly a subtype of
+ * LispError if there are logical problems with the input.
+ */
+ public static final LispObject truename(Pathname pathname,
+ boolean errorIfDoesNotExist)
{
- Pathname pathname = coerceToPathname(arg);
- if (pathname instanceof LogicalPathname)
- pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
- if (pathname.isWild())
+ if (pathname instanceof LogicalPathname) {
+ pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
+ }
+ if (pathname.isWild()) {
return error(new FileError("Bad place for a wild pathname.",
- pathname));
- final Pathname defaultedPathname =
- mergePathnames(pathname,
- coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
- NIL);
- final String namestring = defaultedPathname.getNamestring();
- if (namestring == null)
- return error(new FileError("Pathname has no namestring: " + defaultedPathname.writeToString(),
- defaultedPathname));
- final File file = new File(namestring);
- if (file.isDirectory())
- return Utilities.getDirectoryPathname(file);
- if (file.exists()) {
- try {
- return new Pathname(file.getCanonicalPath());
+ pathname));
+ }
+ if (!(pathname.device instanceof Cons)) {
+ pathname
+ = mergePathnames(pathname,
+ coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
+ NIL);
+ final String namestring = pathname.getNamestring();
+ if (namestring == null) {
+ return error(new FileError("Pathname has no namestring: "
+ + pathname.writeToString(),
+ pathname));
+ }
+
+ final File file = new File(namestring);
+ if (file.isDirectory()) {
+ return Utilities.getDirectoryPathname(file);
+ }
+ if (file.exists()) {
+ try {
+ return new Pathname(file.getCanonicalPath());
+ } catch (IOException e) {
+ return error(new FileError(e.getMessage(), pathname));
+ }
}
- catch (IOException e) {
- return error(new LispError(e.getMessage()));
+ } else
+ jarfile: {
+ // Possibly canonicalize jar file directory
+ Cons jars = (Cons) pathname.device;
+ LispObject o = jars.car();
+ if (o instanceof Pathname) {
+ LispObject truename = Pathname.truename((Pathname)o, errorIfDoesNotExist);
+ if (truename != null
+ && truename instanceof Pathname) {
+ jars.car = (Pathname)truename;
+ } else {
+ break jarfile;
+ }
+ }
+
+ // Check for existence of a JAR file and/or JarEntry
+ //
+ // Cases:
+ // 1. JAR
+ // 2. JAR in JAR
+ // 3. JAR with Entry
+ // 4. JAR in JAR with Entry
+ JarFile jarFile = getJarFile(jars.car());
+ String entryPath = pathname.asEntryPath();
+ if (jarFile != null) {
+ if (jars.cdr() instanceof Cons) {
+ Pathname inner = (Pathname) jars.cdr().car();
+ InputStream inputStream = Utilities.getInputStream(jarFile, inner);
+ if (inputStream != null) {
+ if (entryPath.length() == 0) {
+ return pathname; // Case 2
+ } else {
+ ZipInputStream zipInputStream
+ = new ZipInputStream(inputStream);
+ ZipEntry entry = Utilities.getEntry(zipInputStream,
+ entryPath,
+ false);
+ if (entry != null) {
+ // XXX this could possibly be a directory?
+ return pathname; // Case 4
+ }
+ }
+ }
+ } else {
+ if (entryPath.length() == 0) {
+ return pathname; // Case 1
+ } else {
+ ZipEntry entry = jarFile.getEntry(entryPath);
+ if (entry != null) {
+ // ensure this isn't a directory
+ try {
+ InputStream input = jarFile.getInputStream(entry);
+ if (input != null) {
+ return pathname; // Case 3
+ }
+ } catch (IOException e) {
+ break jarfile;
+ }
+ }
+ }
+ }
}
}
+ error:
if (errorIfDoesNotExist) {
FastStringBuffer sb = new FastStringBuffer("The file ");
- sb.append(defaultedPathname.writeToString());
+ sb.append(pathname.writeToString());
sb.append(" does not exist.");
- return error(new FileError(sb.toString(), defaultedPathname));
+ return error(new FileError(sb.toString(), pathname));
}
return NIL;
}
+
+ /** Make a JarURL from a Pathname that references a file */
+ private static URL makeJarURL(Pathname p) {
+ String jarURL = "jar:file:" + p.getNamestring() + "!/";
+ URL result = null;
+ try {
+ result = new URL(jarURL);
+ } catch (MalformedURLException ex) {
+ // XXX
+ Debug.trace("Could not form URL from pathname "
+ + "'" + jarURL + "'"
+ + " because " + ex);
+ }
+ return result;
+ }
+
+ /** Make a JarURL from a generic URL reference. */
+ private static URL makeJarURL(String url) {
+ String jarURL = "jar:" + url + "!/";
+ URL result = null;
+ try {
+ result = new URL(jarURL);
+ } catch (MalformedURLException ex) {
+ // XXX
+ Debug.trace("Could not form jar URL from "
+ + "'" + jarURL + "'"
+ + " because " + ex);
+ }
+ return result;
+ }
+
+ private static JarFile getJarFile(LispObject device) {
+ URL url = null;
+ if (device instanceof SimpleString) {
+ url = makeJarURL(((SimpleString) device).getStringValue());
+ } else {
+ url = makeJarURL((Pathname) device);
+ }
+ if (url == null) {
+ return null;
+ }
+ URLConnection connection;
+ try {
+ connection = url.openConnection();
+ } catch (IOException ex) {
+ Debug.trace("Failed to open "
+ + "'" + url + "'");
+ return null;
+ }
+ if (!(connection instanceof JarURLConnection)) {
+ // XXX
+ Debug.trace("Could not get a URLConnection from " + url);
+ return null;
+ }
+ JarURLConnection jarURLConnection = (JarURLConnection) connection;
+
+ JarFile result;
+ try {
+ result = jarURLConnection.getJarFile();
+ } catch (IOException ex) {
+ Debug.trace("Could not get a JarURLConnection from "
+ + "'" + jarURLConnection + "'");
+ return null;
+ }
+ return result;
+ }
+
+ public InputStream getInputStream() {
+ InputStream result = null;
+ if (isJar()) {
+ String entryPath = asEntryPath();
+ // XXX We only return the bytes of an entry in a JAR
+ Debug.assertTrue(entryPath != null);
+ JarFile jarFile = Pathname.getJarFile(device.car());
+ Debug.assertTrue(jarFile != null);
+ // Is this a JAR within a JAR?
+ if (device.cdr() instanceof Cons) {
+ Pathname inner = (Pathname) device.cdr().car();
+ InputStream input = Utilities.getInputStream(jarFile, inner);
+ ZipInputStream zipInputStream = new ZipInputStream(input);
+ result = Utilities.getEntryAsInputStream(zipInputStream, entryPath);
+ } else {
+ ZipEntry entry = jarFile.getEntry(entryPath);
+ if (entry == null) {
+ Debug.trace("Failed to get InputStream for "
+ + "'" + getNamestring() + "'");
+
+ Debug.assertTrue(false);
+ }
+ try {
+ result = jarFile.getInputStream(entry);
+ } catch (IOException e) {
+ Debug.trace("Failed to get InputStream from "
+ + "'" + getNamestring() + "'"
+ + ": " + e);
+ }
+ }
+ } else {
+ File file = Utilities.getFile(this);
+ try {
+ result = new FileInputStream(file);
+ } catch (IOException e) {
+ Debug.trace("Failed to get InputStream for read from "
+ + "'" + getNamestring() + "'"
+ + ": " + e);
+ }
+ }
+ return result;
+ }
+
+ // ### last-modified pathname => time-in-milliseconds
+ public static final Primitive LAST_MODIFIED
+ = new Primitive("LAST-MODIFIED", PACKAGE_EXT, true, "pathname",
+ "If PATHNAME exists, returns the last modified time in miliseconds since the UNIX epoch.")
+ {
+ @Override
+ public LispObject execute(LispObject arg) {
+ final Pathname p = coerceToPathname(arg);
+ if (p.isWild()) {
+ error(new FileError("Bad place for a wild pathname.", p));
+ }
+ long time = p.getLastModified();
+ return LispInteger.getInstance(time);
+ }
+ };
+
+ /** @return Time in milliseconds since the UNIX epoch at which the
+ * resource was last modified, or 0 if the time is unknown.
+ */
+ public long getLastModified() {
+ if (!(device instanceof Cons)) {
+ File f = Utilities.getFile(this);
+ return f.lastModified();
+ }
+ // JAR cases
+ // 0. JAR from URL
+ // 1. JAR
+ // 2. JAR in JAR
+ // 3. Entry in JAR
+ // 4. Entry in JAR in JAR
+ String entryPath = asEntryPath();
+ Cons d = (Cons)device;
+ if (d.cdr().equals(NIL)) {
+ if (entryPath.length() == 0) {
+ LispObject o = d.car();
+ if (o instanceof SimpleString) {
+ // 0. JAR from URL
+ URL u = makeJarURL(o.getStringValue());
+ URLConnection c = null;
+ try {
+ c = u.openConnection();
+ } catch(IOException e) {
+ Debug.trace("Failed to open Connection for URL "
+ + "'" + u + "'");
+ return 0;
+ }
+ c.getLastModified();
+ } else {
+ // 1. JAR
+ return ((Pathname)o).getLastModified();
+ }
+ } else {
+ // 3. Entry in JAR
+ final JarEntry entry = getJarFile(device.car()).getJarEntry(entryPath);
+ if (entry == null) {
+ return 0;
+ }
+ final long time = entry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
+ }
+ } else {
+ JarFile outerJar = getJarFile(d.car());
+ if (entryPath.length() == 0) {
+ // 4. JAR in JAR
+ String jarPath = ((Pathname)d.cdr()).asEntryPath();
+ final JarEntry entry = outerJar.getJarEntry(jarPath);
+ final long time = entry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
+ } else {
+ // 5. Entry in JAR in JAR
+ String innerJarPath = ((Pathname)d.cdr()).asEntryPath();
+ ZipEntry entry = outerJar.getEntry(entryPath);
+ ZipInputStream innerJarInputStream
+ = Utilities.getZipInputStream(outerJar, innerJarPath);
+ ZipEntry innerEntry = Utilities.getEntry(innerJarInputStream,
+ entryPath);
+ long time = innerEntry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
+ }
+ }
+ return 0;
+ }
+
// ### mkdir
private static final Primitive MKDIR =
- new Primitive("mkdir", PACKAGE_SYS, false)
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- final Pathname pathname = coerceToPathname(arg);
- if (pathname.isWild())
- error(new FileError("Bad place for a wild pathname.", pathname));
- Pathname defaultedPathname =
- mergePathnames(pathname,
- coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
- NIL);
- File file = Utilities.getFile(defaultedPathname);
- return file.mkdir() ? T : NIL;
- }
- };
+ new Primitive("mkdir", PACKAGE_SYS, false) {
+ @Override
+ public LispObject execute(LispObject arg) {
+ final Pathname pathname = coerceToPathname(arg);
+ if (pathname.isWild()) {
+ error(new FileError("Bad place for a wild pathname.", pathname));
+ }
+ Pathname defaultedPathname =
+ mergePathnames(pathname,
+ coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
+ NIL);
+ File file = Utilities.getFile(defaultedPathname);
+ return file.mkdir() ? T : NIL;
+ }
+ };
// ### rename-file filespec new-name => defaulted-new-name, old-truename, new-truename
public static final Primitive RENAME_FILE =
- new Primitive("rename-file", "filespec new-name")
- {
- @Override
- public LispObject execute(LispObject first, LispObject second)
-
- {
- final Pathname original = (Pathname) truename(first, true);
- final String originalNamestring = original.getNamestring();
- Pathname newName = coerceToPathname(second);
- if (newName.isWild())
- error(new FileError("Bad place for a wild pathname.", newName));
- newName = mergePathnames(newName, original, NIL);
- final String newNamestring;
- if (newName instanceof LogicalPathname)
- newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname)newName).getNamestring();
- else
- newNamestring = newName.getNamestring();
- if (originalNamestring != null && newNamestring != null) {
- final File source = new File(originalNamestring);
- final File destination = new File(newNamestring);
- if (Utilities.isPlatformWindows) {
- if (destination.isFile())
- destination.delete();
- }
- if (source.renameTo(destination))
- // Success!
- return LispThread.currentThread().setValues(newName, original,
- truename(newName, true));
- }
- return error(new FileError("Unable to rename " +
- original.writeToString() +
- " to " + newName.writeToString() +
- "."));
- }
- };
+ new Primitive("rename-file", "filespec new-name") {
+ @Override
+ public LispObject execute(LispObject first, LispObject second) {
+ final Pathname original = (Pathname) truename(first, true);
+ final String originalNamestring = original.getNamestring();
+ Pathname newName = coerceToPathname(second);
+ if (newName.isWild()) {
+ error(new FileError("Bad place for a wild pathname.", newName));
+ }
+ newName = mergePathnames(newName, original, NIL);
+ final String newNamestring;
+ if (newName instanceof LogicalPathname) {
+ newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring();
+ } else {
+ newNamestring = newName.getNamestring();
+ }
+ if (originalNamestring != null && newNamestring != null) {
+ final File source = new File(originalNamestring);
+ final File destination = new File(newNamestring);
+ if (Utilities.isPlatformWindows) {
+ if (destination.isFile()) {
+ destination.delete();
+ }
+ }
+ if (source.renameTo(destination)) // Success!
+ {
+ return LispThread.currentThread().setValues(newName, original,
+ truename(newName, true));
+ }
+ }
+ return error(new FileError("Unable to rename "
+ + original.writeToString()
+ + " to " + newName.writeToString()
+ + "."));
+ }
+ };
// ### file-namestring pathname => namestring
private static final Primitive FILE_NAMESTRING =
- new Primitive("file-namestring", "pathname")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- Pathname p = coerceToPathname(arg);
- FastStringBuffer sb = new FastStringBuffer();
- if (p.name instanceof AbstractString)
- sb.append(p.name.getStringValue());
- else if (p.name == Keyword.WILD)
- sb.append('*');
- else
- return NIL;
- if (p.type instanceof AbstractString) {
- sb.append('.');
- sb.append(p.type.getStringValue());
- } else if (p.type == Keyword.WILD)
- sb.append(".*");
- return new SimpleString(sb);
- }
- };
+ new Primitive("file-namestring", "pathname") {
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname p = coerceToPathname(arg);
+ FastStringBuffer sb = new FastStringBuffer();
+ if (p.name instanceof AbstractString) {
+ sb.append(p.name.getStringValue());
+ } else if (p.name == Keyword.WILD) {
+ sb.append('*');
+ } else {
+ return NIL;
+ }
+ if (p.type instanceof AbstractString) {
+ sb.append('.');
+ sb.append(p.type.getStringValue());
+ } else if (p.type == Keyword.WILD) {
+ sb.append(".*");
+ }
+ return new SimpleString(sb);
+ }
+ };
// ### host-namestring pathname => namestring
private static final Primitive HOST_NAMESTRING =
- new Primitive("host-namestring", "pathname")
- {
- @Override
- public LispObject execute(LispObject arg)
- {
- return coerceToPathname(arg).host;
- }
- };
+ new Primitive("host-namestring", "pathname") {
+
+ @Override
+ public LispObject execute(LispObject arg) {
+ return coerceToPathname(arg).host;
+ }
+ };
+
+ public String toString() {
+ return getNamestring();
+ }
static {
LispObject obj = Symbol.DEFAULT_PATHNAME_DEFAULTS.getSymbolValue();
Symbol.DEFAULT_PATHNAME_DEFAULTS.setSymbolValue(coerceToPathname(obj));
}
}
+
Modified: trunk/abcl/src/org/armedbear/lisp/Site.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Site.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Site.java Sat Feb 6 05:52:32 2010
@@ -42,40 +42,36 @@
public final class Site
{
- private static final String LISP_HOME;
+ private static Pathname LISP_HOME;
- static {
- String lispHome = System.getProperty("abcl.home");
- if (lispHome == null) {
- URL url = Lisp.class.getResource("boot.lisp");
- if (url != null) {
- String protocol = url.getProtocol();
- if (protocol != null && protocol.equals("file")) {
- String path = url.getPath();
- try {
- path = URLDecoder.decode(path, "UTF-8");
- }
- catch (java.io.UnsupportedEncodingException uee) {
- // can't happen: Java implementations are required to
- // support UTF-8
- }
- int index = path.lastIndexOf('/');
- if (index >= 0) {
- lispHome = path.substring(0, index + 1);
- if (Utilities.isPlatformWindows) {
- if (lispHome.length() > 0 && lispHome.charAt(0) == '/')
- lispHome = lispHome.substring(1);
- }
- }
- }
+ private static void init() {
+ String s = System.getProperty("abcl.home");
+ if (s != null) {
+ String fileSeparator = System.getProperty("file.separator");
+ if (!s.endsWith(fileSeparator)) {
+ s += fileSeparator;;
}
+ LISP_HOME = new Pathname(s);
+ return;
+ }
+ URL url = Lisp.class.getResource("boot.lisp");
+ if (url != null) {
+ LISP_HOME = new Pathname(url);
+ LISP_HOME.name = NIL;
+ LISP_HOME.type = NIL;
+ LISP_HOME.invalidateNamestring();
+ return;
}
- LISP_HOME = lispHome;
+ Debug.trace("Unable to determine LISP_HOME.");
}
- public static final String getLispHome()
+
+ public static final Pathname getLispHome()
{
- return LISP_HOME;
+ if (LISP_HOME == null) {
+ init();
+ }
+ return LISP_HOME;
}
// ### *lisp-home*
@@ -83,8 +79,8 @@
exportSpecial("*LISP-HOME*", PACKAGE_EXT, NIL);
static {
- String s = Site.getLispHome();
- if (s != null)
- _LISP_HOME_.setSymbolValue(new Pathname(s));
+ Pathname p = Site.getLispHome();
+ if (p != null)
+ _LISP_HOME_.setSymbolValue(p);
}
}
Modified: trunk/abcl/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Stream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Stream.java Sat Feb 6 05:52:32 2010
@@ -394,7 +394,7 @@
{
LispObject result = readPreservingWhitespace(eofError, eofValue,
- recursive, thread);
+ recursive, thread);
if (result != eofValue && !recursive) {
try {
if (_charReady()) {
@@ -422,9 +422,9 @@
internSpecial("*SHARP-EQUAL-ALIST*", PACKAGE_SYS, NIL);
public LispObject readPreservingWhitespace(boolean eofError,
- LispObject eofValue,
- boolean recursive,
- LispThread thread)
+ LispObject eofValue,
+ boolean recursive,
+ LispThread thread)
{
if (recursive) {
@@ -434,6 +434,7 @@
try {
n = _readChar();
} catch (IOException e) {
+ Debug.trace(e);
error(new StreamError(this, e));
}
if (n < 0) {
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Sat Feb 6 05:52:32 2010
@@ -2909,6 +2909,8 @@
PACKAGE_EXT.addExternalSymbol("GETENV");
public static final Symbol MACROEXPAND_ALL =
PACKAGE_EXT.addExternalSymbol("MACROEXPAND-ALL");
+ public static final Symbol LOAD_TRUENAME_FASL =
+ PACKAGE_EXT.addExternalSymbol("*LOAD-TRUENAME-FASL*");
// MOP.
public static final Symbol STANDARD_READER_METHOD =
Modified: trunk/abcl/src/org/armedbear/lisp/Utilities.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Utilities.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Utilities.java Sat Feb 6 05:52:32 2010
@@ -40,6 +40,7 @@
import java.io.File;
import java.io.IOException;
import java.io.InputStream;
+import java.util.jar.JarFile;
import java.util.zip.ZipEntry;
import java.util.zip.ZipFile;
import java.util.zip.ZipInputStream;
@@ -124,60 +125,133 @@
return null;
}
}
-
- public static byte[] getZippedZipEntryAsByteArray(ZipFile zipfile,
- String entryName,
- String subEntryName)
- {
- ZipEntry entry = zipfile.getEntry(entryName);
-
- ZipInputStream stream = null;
- try {
- stream = new ZipInputStream(zipfile.getInputStream(entry));
- }
- catch (IOException e) {
+ public static ZipInputStream getZipInputStream(ZipFile zipfile,
+ String entryName) {
+ return Utilities.getZipInputStream(zipfile, entryName, false);
+ }
+
+ public static ZipInputStream getZipInputStream(ZipFile zipfile,
+ String entryName,
+ boolean errorOnFailure) {
+ ZipEntry zipEntry = zipfile.getEntry(entryName);
+ ZipInputStream stream = null;
+ try {
+ stream = new ZipInputStream(zipfile.getInputStream(zipEntry));
+ } catch (IOException e) {
+ if (errorOnFailure) {
Lisp.error(new FileError("Failed to open '" + entryName + "' in zipfile '"
+ zipfile + "': " + e.getMessage()));
}
- // XXX Cache the zipEntries somehow
- do {
- try {
- entry = stream.getNextEntry();
- } catch (IOException e){
- Lisp.error(new FileError("Failed to seek for '" + subEntryName
- + "' in '"
- + zipfile.getName() + ":" + entryName + ".:"
- + e.getMessage()));
- }
- } while (!entry.getName().equals(subEntryName));
-
- ByteArrayOutputStream buffer = new ByteArrayOutputStream();
+ return null;
+ }
+ return stream;
+ }
+
+ public static InputStream getEntryAsInputStream(ZipInputStream zipInputStream,
+ String entryName)
+ {
+ ZipEntry entry = getEntry(zipInputStream, entryName);
+ ByteArrayOutputStream bytes = readEntry(zipInputStream);
+ return new ByteArrayInputStream(bytes.toByteArray());
+
+ }
+
+ public static ByteArrayOutputStream readEntry(ZipInputStream stream) {
+ ByteArrayOutputStream result = new ByteArrayOutputStream();
int count;
byte buf[] = new byte[1024];
try {
while ((count = stream.read(buf, 0, buf.length)) != -1) {
- buffer.write(buf, 0, count);
+ result.write(buf, 0, count);
}
} catch (java.io.IOException e) {
- Lisp.error(new FileError("Failed to read compressed '"
- + subEntryName
- + "' in '"
- + zipfile.getName() + ":" + entryName + ":"
- + e.getMessage()));
+ Debug.trace("Failed to read entry from "
+ + stream
+ + ": " + e);
+ return null;
}
- return buffer.toByteArray();
+ return result;
+ }
+
+ public static ZipEntry getEntry(ZipInputStream zipInputStream, String entryName) {
+ return Utilities.getEntry(zipInputStream, entryName, false);
}
-
- public static InputStream getZippedZipEntryAsInputStream(ZipFile zipfile,
- String entryName,
- String subEntryName)
+ public static ZipEntry getEntry(ZipInputStream zipInputStream,
+ String entryName,
+ boolean errorOnFailure)
{
- return
- new ByteArrayInputStream(Utilities
- .getZippedZipEntryAsByteArray(zipfile, entryName,
- subEntryName));
+ ZipEntry entry = null;
+ do {
+ try {
+ entry = zipInputStream.getNextEntry();
+ } catch (IOException e) {
+ if (errorOnFailure) {
+ Lisp.error(new FileError("Failed to seek for "
+ + "'" + entryName + "'"
+ + " in " + zipInputStream.toString()));
+ }
+ return null;
+ }
+ } while (entry != null && !entry.getName().equals(entryName));
+ if (entry != null) {
+ return entry;
+ }
+ if (errorOnFailure) {
+ Lisp.error(new FileError("Failed to find "
+ + "'" + entryName + "'"
+ + " in " + zipInputStream.toString()));
+ }
+ return null;
+
}
-}
+
+ public static final boolean checkZipFile(Pathname name) {
+ InputStream input = name.getInputStream();
+ try {
+ byte[] bytes = new byte[4];
+ int bytesRead = input.read(bytes);
+ return (bytesRead == 4
+ && bytes[0] == 0x50
+ && bytes[1] == 0x4b
+ && bytes[2] == 0x03
+ && bytes[3] == 0x04);
+ } catch (Throwable t) { // any error probably means 'no'
+ return false;
+ } finally {
+ if (input != null) {
+ try {
+ input.close();
+ }
+ catch (IOException e) {} // ignore exceptions
+ }
+ }
+ }
+ static InputStream getInputStream(JarFile jarFile, Pathname inner) {
+ String entryPath = inner.asEntryPath();
+ ZipEntry entry = jarFile.getEntry(entryPath);
+ if (entry == null) {
+ Debug.trace("Failed to find entry "
+ + "'" + entryPath + "'"
+ + " in "
+ + "'" + jarFile.getName() + "'");
+ return null;
+ }
+ InputStream result = null;
+ try {
+ result = jarFile.getInputStream(entry);
+ } catch (IOException e) {
+ Debug.trace("Failed to open InputStream for "
+ + "'" + entryPath + "'"
+ + " in "
+ + "'" + jarFile.getName() + "'");
+ return null;
+ }
+ return result;
+ }
+
+
+
+}
Added: trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/asdf-abcl.lisp Sat Feb 6 05:52:32 2010
@@ -0,0 +1,48 @@
+;;; asdf-abcl.lisp
+;;;
+;;; Copyright (C) 2010 Mark Evenson
+;;; $Id: package.lisp 12418 2010-02-05 15:41:42Z mevenson $
+;;;
+;;; 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.
+
+(in-package :asdf)
+;;;; ABCL-specific extensions to ASDF, placed in a separate file from
+;;;; asdf.lisp so that we can track upstream ASDF versions easier.
+
+;;; We don't compile if the output location would be within a JAR
+;;; file, which is currently always an unwritable location in ABCL.
+;;; This allows us to load ASDF definitions that are packaged in JARs.
+;;;
+;;; XXX How does this work with ASDF-BINARY-LOCATIONS?
+(defmethod operation-done-p :around ((o compile-op)
+ (c cl-source-file))
+ (let ((files (output-files o c)))
+ (if (every #'sys:pathname-jar-p files)
+ t
+ (call-next-method))))
+
+(provide 'asdf-abcl)
Modified: trunk/abcl/src/org/armedbear/lisp/asdf.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/asdf.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/asdf.lisp Sat Feb 6 05:52:32 2010
@@ -1173,4 +1173,5 @@
(pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)
(pushnew 'contrib-sysdef-search *system-definition-search-functions*))
+(require 'asdf-abcl)
(provide 'asdf)
Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp Sat Feb 6 05:52:32 2010
@@ -121,12 +121,13 @@
(load (do-compile "concatenate.lisp"))
(load (do-compile "ldb.lisp"))
(load (do-compile "destructuring-bind.lisp"))
+ (load (do-compile "asdf.lisp"))
;; But not for these.
(mapc #'do-compile '("adjoin.lisp"
"and.lisp"
"apropos.lisp"
"arrays.lisp"
- "asdf.lisp"
+ "asdf-abcl.lisp"
"assert.lisp"
"assoc.lisp"
"autoloads.lisp"
@@ -211,8 +212,8 @@
"or.lisp"
"parse-integer.lisp"
"parse-lambda-list.lisp"
- "pathnames.lisp"
"package.lisp"
+ "pathnames.lisp"
"print-object.lisp"
"print-unreadable-object.lisp"
"proclaim.lisp"
Modified: trunk/abcl/src/org/armedbear/lisp/file_write_date.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/file_write_date.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/file_write_date.java Sat Feb 6 05:52:32 2010
@@ -51,8 +51,7 @@
Pathname pathname = coerceToPathname(arg);
if (pathname.isWild())
error(new FileError("Bad place for a wild pathname.", pathname));
- File file = Utilities.getFile(pathname);
- long lastModified = file.lastModified();
+ long lastModified = pathname.getLastModified();
if (lastModified == 0)
return NIL;
return number(lastModified / 1000 + 2208988800L);
Added: trunk/abcl/src/org/armedbear/lisp/unzip.java
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/unzip.java Sat Feb 6 05:52:32 2010
@@ -0,0 +1,121 @@
+/*
+ * unzip.java
+ *
+ * Copyright (C) 2010 Mark Evenson
+ * $Id: unzip.java 12288 2009-11-29 22:00:12Z vvoutilainen $
+ *
+ * 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 org.armedbear.lisp;
+
+import static org.armedbear.lisp.Lisp.*;
+import java.io.File;
+import java.io.InputStream;
+import java.io.FileOutputStream;
+import java.io.IOException;
+import java.util.Enumeration;
+import java.util.zip.ZipEntry;
+import java.util.zip.ZipFile;
+
+// ### unzip pathname directory => unzipped_pathnames
+public final class unzip
+ extends Primitive
+{
+ public unzip() {
+ super("unzip", PACKAGE_SYS, true, "pathname &optional directory => unzipped_pathnames");
+ }
+
+ @Override
+ public LispObject execute(LispObject first) {
+ Pathname zipFile = coerceToPathname(first);
+ Pathname directory = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
+ return unzipToDirectory(zipFile, directory);
+ }
+
+ @Override
+ public LispObject execute(LispObject first, LispObject second) {
+ Pathname zipFile = coerceToPathname(first);
+ Pathname directory = coerceToPathname(second);
+ directory.name = NIL;
+ directory.type = NIL;
+ directory.invalidateNamestring();
+ return unzipToDirectory(zipFile, directory);
+ }
+
+ private LispObject unzipToDirectory(Pathname zipPath, Pathname dirPath) {
+ if (!zipPath.isAbsolute()) {
+ zipPath = Pathname.mergePathnames(zipPath,
+ coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()));
+ }
+ LispObject o = Pathname.truename(zipPath, false);
+ if (!(o instanceof Pathname)) {
+ return error(new FileError("No file found: " + zipPath, zipPath));
+ }
+ String zip = ((Pathname)o).getNamestring();
+ if (zip == null) {
+ return error(new FileError("Pathname has no namestring: " + zip, zipPath));
+ }
+ String dir = dirPath.getNamestring();
+ if (dir == null) {
+ return error(new FileError("Could not parse diretory: " + dirPath, dirPath));
+ }
+ LispObject result = NIL;
+ try {
+ ZipFile zipfile = new ZipFile(zip);
+
+ byte[] buffer = new byte[4096];
+ for (Enumeration<? extends ZipEntry> entries = zipfile.entries();entries.hasMoreElements();) {
+ ZipEntry entry = entries.nextElement();
+ String name = entry.getName();
+ String filename = dir + name;
+ File file = new File(filename);
+ if (entry.isDirectory()) {
+ file.mkdirs();
+ continue;
+ }
+ FileOutputStream out = new FileOutputStream(file);
+ InputStream in = zipfile.getInputStream(entry);
+ int n;
+ while ((n = in.read(buffer)) > 0) {
+ out.write(buffer, 0, n);
+ }
+ out.close();
+ in.close();
+ result = result.push(new Pathname(filename));
+ }
+ } catch (IOException e) {
+ return error(new FileError("Failed to unzip "
+ + "'" + zipPath + "'"
+ + " into " + "'" + dirPath + "'"
+ + ": " + e, zipPath));
+ }
+ return result;
+ }
+
+ private static final Primitive unzip = new unzip();
+}
More information about the armedbear-cvs
mailing list