io.pathnames: Added ~/ (tilde) prefix recognition as a special pathname.

vocab:, resource: and ~/ are special pathnames. Modified absolute-path word,
added test cases and updated io.pathname documentation.

diff --git a/core/io/pathnames/pathnames-docs.factor b/core/io/pathnames/pathnames-docs.factor
index dbbb88631257ac631cec9c61b8b82eb4f3ec8a81..d20db3f3a98f1090ffd67a422d4c4440ba133f39 100644 (file)
--- a/core/io/pathnames/pathnames-docs.factor
+++ b/core/io/pathnames/pathnames-docs.factor
@@ -106,8 +106,8 @@ HELP: absolute-path
     { "path" "a pathname string" }
     { "path'" "a pathname string" }
 }
-{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " or " { $snippet "vocab:" } " prefix, if present (see " { $link "io.pathnames.special" } ")." }
-{ $notes "This word is exaclty the same as " { $link normalize-path } ", except on Windows NT platforms, where it does not prepend the Unicode path prefix. Most code should call " { $link normalize-path } " instead." } ;
+{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } ", " { $snippet "~/" } " or " { $snippet "vocab:" } " prefix, if present (see " { $link "io.pathnames.special" } ")." }
+{ $notes "This word is exactly the same as " { $link normalize-path } ", except on Windows NT platforms, where it does not prepend the Unicode path prefix. Most code should call " { $link normalize-path } " instead." } ;
 
 HELP: resolve-symlinks
 { $values { "path" "a pathname string" } { "path'" "a new pathname string" } }
@@ -131,7 +131,9 @@ HELP: home
 ARTICLE: "io.pathnames.special" "Special pathnames"
 "If a pathname begins with " { $snippet "resource:" } ", it is resolved relative to the directory containing the current image (see " { $link image } ")."
 $nl
-"If a pathname begins with " { $snippet "vocab:" } ", then it will be searched for in all current vocabulary roots (see " { $link "add-vocab-roots" } ")." ;
+"If a pathname begins with " { $snippet "vocab:" } ", then it will be searched for in all current vocabulary roots (see " { $link "add-vocab-roots" } ")."
+$nl
+"If a pathname begins with " { $snippet "~/" } ", it will be searched for in the home directory. Subsequent tildes in the pathname will be construed as literal tilde path or filenames and will not be treated specially. It should be noted that the " { $snippet "~" } " symbol without a forward slash will be also be treated as a literal path or filename." ;
 
 ARTICLE: "io.pathnames.presentations" "Pathname presentations"
 "Pathname presentations are objects that wrap a pathname string. Clicking a pathname presentation in the UI brings up the file in one of the supported editors. See " { $link "editor" } " for more details."

diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor
index f23a1ac1f4f9856ea876d6b59baeae8aee8a6f76..6c92a83bd5a4f818ef2ff80e0ab55ad014c1b7cd 100644 (file)
--- a/core/io/pathnames/pathnames-tests.factor
+++ b/core/io/pathnames/pathnames-tests.factor
@@ -1,6 +1,6 @@
 USING: io.pathnames io.files.temp io.directories
 continuations math io.files.private kernel
-namespaces tools.test io.pathnames.private ;
+namespaces sequences tools.test io.pathnames.private ;
 IN: io.pathnames.tests
 
 [ "passwd" ] [ "/etc/passwd" file-name ] unit-test
@@ -70,3 +70,9 @@ IN: io.pathnames.tests
 ! Regression test for bug in file-extension
 [ f ] [ "/funny.directory/file-with-no-extension" file-extension ] unit-test
 [ "" ] [ "/funny.directory/file-with-no-extension." file-extension ] unit-test
+
+! Testing ~/ special pathname
+[ t ] [ "~/" absolute-path home = ] unit-test 
+[ f ] [ "~" absolute-path home = ] unit-test
+[ t ] [ "~/~" absolute-path "/~" home prepend = ] unit-test
+[ t ] [ "~/~/" absolute-path "/~/" home prepend = ] unit-test

diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor
index 6285fd716a214e5306d4f21689ce2fbe2ef9a26e..911235e01766afb7d01110e8a8262b88fca1787b 100644 (file)
--- a/core/io/pathnames/pathnames.factor
+++ b/core/io/pathnames/pathnames.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators io.backend kernel math math.order
+USING: accessors combinators environment io.backend kernel math math.order
 namespaces sequences splitting strings system ;
 IN: io.pathnames
 
@@ -135,6 +135,10 @@ M: object resolve-symlinks normalize-path ;
 : resource-path ( path -- newpath )
     "resource-path" get prepend-path ;
 
+HOOK: home io-backend ( -- dir )
+
+M: object home "" resource-path ;
+
 GENERIC: vocab-path ( path -- newpath )
 
 GENERIC: absolute-path ( path -- path' )
@@ -148,8 +152,12 @@ M: string absolute-path
             trim-head-separators vocab-path
             absolute-path
         ] [
+            "~/" ?head [
+                trim-head-separators home prepend-path
+                absolute-path
+        ] [    
             current-directory get prepend-path
-        ] if
+        ] if ] if 
     ] if ;
 
 M: object normalize-path ( path -- path' )
@@ -163,6 +171,3 @@ M: pathname absolute-path string>> absolute-path ;
 
 M: pathname <=> [ string>> ] compare ;
 
-HOOK: home io-backend ( -- dir )
-
-M: object home "" resource-path ;