[Openmcl-cvs-notifications] r14020 - /trunk/source/level-1/l1-pathnames.lisp

[rme at clozure.com]

Author: rme
Date: Thu Jul 22 22:19:54 2010
New Revision: 14020

Log:
In FULL-PATHNAME, get a suitable device pathname component from
MAC-HOME-DIRECTORY if none is present in the passed-in path.

Modified:
    trunk/source/level-1/l1-pathnames.lisp

Modified: trunk/source/level-1/l1-pathnames.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-pathnames.lisp (original)
+++ trunk/source/level-1/l1-pathnames.lisp Thu Jul 22 22:19:54 2010
@@ -682,14 +682,20 @@
                  (error (condition) (if no-error
                                       (return-from full-pathname nil)
                                       (error condition)))))
-         (dir (%pathname-directory path)))
-    (if (eq (car dir) :absolute)
-      path
-      (cons-pathname (absolute-directory-list dir)
-                       (%pathname-name path)
-                       (%pathname-type path)
-                       (pathname-host path)
-                       (pathname-version path)))))
+         (dir (%pathname-directory path))
+	 (device #+windows-target
+	         (or (pathname-device path)
+		     (pathname-device (mac-default-directory)))
+		 #-windows-target
+		 nil))
+    (cons-pathname (if (eq (car dir) :absolute)
+		     dir
+		     (absolute-directory-list dir))
+		   (%pathname-name path)
+		   (%pathname-type path)
+		   (pathname-host path)
+		   (pathname-version path)
+		   device)))
 =

 =

 =