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

[Mark Evenson]

Author: mevenson
Date: Sat Jul 10 16:08:43 2010
New Revision: 12797

Log:
Convert to a$$-backwards Pollock.



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

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 Jul 10 16:08:43 2010
@@ -606,8 +606,8 @@
         // the namestring." 19.2.2.2.3.1
         if (host != NIL) {
             Debug.assertTrue(host instanceof AbstractString 
-                             || isURL());
-            if (isURL()) {
+                             || host instanceof Cons);
+            if (host instanceof Cons) {
                 LispObject scheme = Symbol.GETF.execute(host, SCHEME, NIL);
                 LispObject authority = Symbol.GETF.execute(host, AUTHORITY, NIL);
                 Debug.assertTrue(scheme != NIL);
@@ -631,7 +631,7 @@
         }
         if (device == NIL) {
         } else if (device == Keyword.UNSPECIFIC) {
-        } else if (isJar()) {
+        } else if (device instanceof Cons) {
             LispObject[] jars = ((Cons) device).copyToArray();
             StringBuilder prefix = new StringBuilder();
             for (int i = 0; i < jars.length; i++) {
@@ -643,6 +643,9 @@
                 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
@@ -720,7 +723,7 @@
             }
         }
         namestring = sb.toString();
-        // XXX Decide if this is necessary
+        // XXX Decide when this is necessary
         // if (isURL()) { 
         //     namestring = Utilities.uriEncode(namestring);
         // }
@@ -1233,7 +1236,7 @@
             namestring = file.getCanonicalPath();
         } catch (IOException e) {
             Debug.trace("Failed to make a Pathname from "
-              + "'" + file + "'");
+              + "." + file + "'");
             return null;
         }
         return new Pathname(namestring);
@@ -1287,7 +1290,7 @@
             if (host == NIL) {
                 host = defaults.host;
             }
-            if (directory == NIL) {
+            if (directory == NIL && defaults != null) {
                 directory = defaults.directory;
             }
             if (!deviceSupplied) {
@@ -2081,8 +2084,7 @@
             if (pathname.isURL()) {
                 result = new URL(pathname.getNamestring());
             } else {
-                // XXX Properly encode Windows drive letters and UNC paths
-                // XXX ensure that we have cannonical path?
+                // XXX ensure that we have cannonical path.
                 result = new URL("file://" + pathname.getNamestring());
             }
         } catch (MalformedURLException e) {

Modified: trunk/abcl/src/org/armedbear/lisp/ShellCommand.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ShellCommand.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/ShellCommand.java	Sat Jul 10 16:08:43 2010
@@ -235,9 +235,13 @@
 
     // run-shell-command command &key directory (output *standard-output*)
     // ### %run-shell-command command directory output => exit-code
-    private static final Primitive _RUN_SHELL_COMMAND =
-        new Primitive("%run-shell-command", PACKAGE_SYS, false)
-    {
+    private static final Primitive _RUN_SHELL_COMMAND = new pf_run_shell_command();
+    private static class pf_run_shell_command extends Primitive {
+        pf_run_shell_command() {
+            super("%run-shell-command", PACKAGE_SYS, false,
+                  "command directory output => exit-code");
+        }
+        
         @Override
         public LispObject execute(LispObject first, LispObject second,
                                   LispObject third)