[cl-xml-cvs] r11 - branches/sbcl-0.9.x-testing/code/base

[banderson at common-lisp.net]

Author: banderson
Date: Tue Feb 14 11:56:21 2006
New Revision: 11

Modified:
   branches/sbcl-0.9.x-testing/code/base/utils.lisp
Log:
bad hack to get around endless loop - this is *not* the permanent solution, because James Anderson already reported it doesn't work for his Lisp (some *MCL).  However, this works for SBCL.

Modified: branches/sbcl-0.9.x-testing/code/base/utils.lisp
==============================================================================
--- branches/sbcl-0.9.x-testing/code/base/utils.lisp	(original)
+++ branches/sbcl-0.9.x-testing/code/base/utils.lisp	Tue Feb 14 11:56:21 2006
@@ -393,7 +393,7 @@
            (setf default-host (host-string defaults)
                  default-path (path defaults))
            (return))
-          (string (setf defaults (make-uri defaults nil)))
+          (string (return)) ;;(setf defaults (make-uri defaults nil)))
           (pathname (setf defaults (pathname-file-url defaults)))
           (urn (return))
           (null (return))))
@@ -590,6 +590,11 @@
            "allow host, ignore device, which should be :unspecific"
            (let ((host (pathname-host pathname)))
              (when (eq host :unspecific) (setf host nil))
+	     #+sbcl
+	     (progn
+	       (setf host nil)
+	       (setf pathname (translate-logical-pathname pathname)))
+
              (pathname-file-url (format nil "file://~@[~a~]/~{~a/~}~a~@[.~a~]"
                                         host
                                         (rest (pathname-directory pathname))