Changeset 15409

Timestamp:

10/14/20 07:07:16 (2 years ago)

Author:

Mark Evenson

Message:

pathname: various fixed in order to work Windows

Don't use #P reader macro in source as it can throw errors. Use
PATHNAME function instead.

LOAD for URL-PATHNAME working under Windows

TODO work through ramifications of needing to uri-encode whitespace
and other components for URLPathname.

Give up on java.net.{URL,URI} for construction of pathnames, as they
provide no help in uri encoding and fail to account for
MSDOS drive letters.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• JarPathname.java (modified) (2 diffs)
• Pathname.java (modified) (4 diffs)
• URLPathname.java (modified) (4 diffs)
• abcl-contrib.lisp (modified) (2 diffs)

trunk/abcl/src/org/armedbear/lisp/JarPathname.java

@@ -71 +71 @@
     if (p instanceof URLPathname) {
       return JarPathname.create(JAR_URI_PREFIX
-                                + ((URLPathname)p).getNamestringAsURI()
+                                + ((URLPathname)p).getNamestringAsURL()
                                 + JAR_URI_SUFFIX);
     } else if (p instanceof Pathname) {
@@ -280 +280 @@
 
     if (root instanceof URLPathname) {
-      String ns = ((URLPathname)root).getNamestringAsURI();
+      String ns = ((URLPathname)root).getNamestringAsURL();
       sb.append(JAR_URI_PREFIX)
         .append(ns)

trunk/abcl/src/org/armedbear/lisp/Pathname.java

@@ -57 +57 @@
       return (JarPathname)JarPathname.create(p.getNamestring());
     } else if (p instanceof URLPathname) {
-      return (URLPathname)URLPathname.create(((URLPathname)p).getNamestringAsURI());
+      return (URLPathname)URLPathname.create(((URLPathname)p).getNamestringAsURL());
     } else {
       return new Pathname(p);
@@ -1663 +1663 @@
     }
 
-      if (pathname.getHost() != NIL) {
-        result.setHost(p.getHost());
-      } else {
-        result.setHost(d.getHost());
-      }
-
-      if (pathname.getDevice() != NIL) {
+    if (pathname.getHost().equals(NIL)) {
+      result.setHost(d.getHost());
+    } else {
+      result.setHost(p.getHost());
+    }
+
+      if (!pathname.getDevice().equals(NIL)) {
         if (!Utilities.isPlatformWindows) {
           result.setDevice(p.getDevice());
@@ -1676 +1676 @@
         && p instanceof JarPathname) {
             result.setDevice(d.getDevice());
-          } else { 
+          } else {
             result.setDevice(p.getDevice());
           }
@@ -1694 +1694 @@
           }
         } else {
-          result.setDevice(d.getDevice());
+    if (p.isLocalFile() && d.isLocalFile()) {
+      result.setDevice(d.getDevice());
+    } else {
+      result.setDevice(p.getDevice());
+    }
         }
       }

trunk/abcl/src/org/armedbear/lisp/URLPathname.java

@@ -200 +200 @@
       }
     }
+    if (Utilities.isPlatformWindows
+  && getDevice() instanceof SimpleString) {
+      sb.append(getDevice().getStringValue())
+  .append(":");
+    }
     String directoryNamestring = getDirectoryNamestring();
     sb.append(directoryNamestring);
@@ -226 +231 @@
   }
 
-  public String getNamestringAsURI() {
+  // TODO URIEncode path components?
+  public String getNamestringAsURL() {
     LispObject schemeProperty = Symbol.GETF.execute(getHost(), SCHEME, NIL);
     LispObject authorityProperty = Symbol.GETF.execute(getHost(), AUTHORITY, NIL);
@@ -247 +253 @@
 
     if (!directory.equals("")) {
-      path = directory + file;
+      if (Utilities.isPlatformWindows
+    && getDevice() instanceof SimpleString) {
+  path = getDevice().getStringValue() + ":" + directory + file;
+      } else {
+  path = directory + file;
+      }
     } else {
       path = file;
@@ -262 +273 @@
     }
 
-    try {
-      URI uri = new URI(scheme, authority, path, query, fragment);
-      return uri.toString();
-    } catch (URISyntaxException e) {
-      simple_error("Failed to construct a URI: ~a", this);
-      return (String)UNREACHED;
-    }
+    StringBuffer result = new StringBuffer(scheme);
+    result.append(":");
+    result.append("//");
+    if (authority != null) {
+      result.append(authority);
+    }
+    if (!path.startsWith("/")) {
+      result.append("/");
+    }
+    result.append(path);
+
+    if (query != null) {
+      result.append("?").append(query);
+    }
+
+    if (fragment != null) {
+      result.append("#").append(fragment);
+    }
+    return result.toString();
   }
 

trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

@@ -57 +57 @@
    ;; it would minimally need to check version information.
    (ignore-errors
-     #p"jar:https://abcl.org/releases/1.7.1/abcl.jar!/")))
+     (pathname "jar:https://abcl.org/releases/1.7.1/abcl.jar!/"))))
 
 (defun flatten (list)
@@ -114 +114 @@
                :type "jar"))))
       (let ((jar (some predicate entries)))
-  (when jar
+  (when (and jar (probe-file jar))
     (return-from find-jar
-            (make-pathname :device (list jar))))))))
+            (make-pathname :device (list (probe-file jar)))))))))
 
 (defun find-system-jar ()