FileURI.st
changeset 4182 4c84b6a60de4
parent 3453 a49af911b6e0
--- a/FileURI.st	Fri Oct 28 17:32:12 2016 +0200
+++ b/FileURI.st	Fri Oct 28 17:34:56 2016 +0200
@@ -11,6 +11,8 @@
 "
 "{ Package: 'stx:libbasic2' }"
 
+"{ NameSpace: Smalltalk }"
+
 HierarchicalURI subclass:#FileURI
 	instanceVariableNames:''
 	classVariableNames:''
@@ -55,20 +57,23 @@
 asFilename
     "answer the receiver represented as filename"
 
-    ^ authority notNil ifTrue:[
+    ^ authority notEmptyOrNil ifTrue:[
         Filename remoteHost:authority rootComponents:pathSegments.
     ] ifFalse:[
-        "kludge"
-        (pathSegments first startsWith:$~) ifTrue:[
-            pathSegments first asFilename construct:(Filename rootComponents:(pathSegments copyFrom:2)).
+        isAbsolute ifTrue:[
+            Filename rootComponents:pathSegments.
         ] ifFalse:[
-            Filename rootComponents:pathSegments.
+            Filename fromComponents:pathSegments.
         ].
     ].
 
     "
-        (URI fromString:'file:~/bla') asFilename
-        (URI fromString:'file:~root/bla') asFilename 
+        (URI fromString:'file:///dir/file') asFilename
+        (URI fromString:'file:///C:dir/file') asFilename
+        (URI fromString:'file:///C:/dir/file') asFilename
+        (URI fromString:'file:///~/bla') asFilename
+        (URI fromString:'file:///~root/bla') asFilename 
+        (URI fromString:'file:////host/dir/file') asFilename 
     "
 ! !
 
@@ -77,29 +82,37 @@
 fromFilename:aFilename
     "create an URI based on an a filename"
 
-    |components|
+    |volume|
 
-    components := aFilename components.
+    pathSegments := aFilename components.
     aFilename isAbsolute ifTrue:[
-        (components size > 3 and:[(components at:2) size == 0]) ifTrue:[
+        (pathSegments notEmpty and:[pathSegments first startsWith:'\\']) ifTrue:[
             "this is a MS-Windows network path: \\host\path"
-            authority := components at:3.
-            pathSegments := components copyFrom:4.
+            isAbsolute := false. "there are already enogh / in the first pathComponent"
+            pathSegments at:1 put:(pathSegments first replaceAll:$\ with:$/).
         ] ifFalse:[
             "this is an absolute path"
             isAbsolute := true.
-            pathSegments := components copyFrom:2.
+            volume := aFilename volume.
+            volume notEmpty ifTrue:[
+                pathSegments at:1 put:volume.
+            ].
         ].
     ] ifFalse:[
         "this is a relative path"
         isAbsolute := false.
-        pathSegments := components.
     ]
 
     "
       self fromFilename:'/a/b/c'  asFilename   
       self fromFilename:'//a/b/c' asFilename  
       self fromFilename:'a/b/c'   asFilename    
+
+      self fromFilename:'\a\b\c'  asFilename   
+      self fromFilename:'~user\a\b\c'  asFilename   
+      self fromFilename:'C:\a\b\c'  asFilename   
+      self fromFilename:'\\a\b\c'  asFilename 
+      self fromFilename:'a\b\c'   asFilename    
     "
 ! !
 
@@ -352,10 +365,10 @@
 !FileURI class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.18 2014-12-02 14:22:43 stefan Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.18 2014-12-02 14:22:43 stefan Exp $'
+    ^ '$Header$'
 ! !