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.
db4
otoburb 2011-12-21 16:35:05 +00:00
parent 7417d8f0c8
commit a5e8cc75b9
3 changed files with 22 additions and 9 deletions

View File

@ -106,8 +106,8 @@ HELP: absolute-path
{ "path" "a pathname string" } { "path" "a pathname string" }
{ "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" } ")." } { $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 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." } ; { $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 HELP: resolve-symlinks
{ $values { "path" "a pathname string" } { "path'" "a new pathname string" } } { $values { "path" "a pathname string" } { "path'" "a new pathname string" } }
@ -131,7 +131,9 @@ HELP: home
ARTICLE: "io.pathnames.special" "Special pathnames" 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 } ")." "If a pathname begins with " { $snippet "resource:" } ", it is resolved relative to the directory containing the current image (see " { $link image } ")."
$nl $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" 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." "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."

View File

@ -1,6 +1,6 @@
USING: io.pathnames io.files.temp io.directories USING: io.pathnames io.files.temp io.directories
continuations math io.files.private kernel continuations math io.files.private kernel
namespaces tools.test io.pathnames.private ; namespaces sequences tools.test io.pathnames.private ;
IN: io.pathnames.tests IN: io.pathnames.tests
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test [ "passwd" ] [ "/etc/passwd" file-name ] unit-test
@ -70,3 +70,9 @@ IN: io.pathnames.tests
! Regression test for bug in file-extension ! Regression test for bug in file-extension
[ f ] [ "/funny.directory/file-with-no-extension" file-extension ] unit-test [ f ] [ "/funny.directory/file-with-no-extension" file-extension ] unit-test
[ "" ] [ "/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

View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman. ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; namespaces sequences splitting strings system ;
IN: io.pathnames IN: io.pathnames
@ -135,6 +135,10 @@ M: object resolve-symlinks normalize-path ;
: resource-path ( path -- newpath ) : resource-path ( path -- newpath )
"resource-path" get prepend-path ; "resource-path" get prepend-path ;
HOOK: home io-backend ( -- dir )
M: object home "" resource-path ;
GENERIC: vocab-path ( path -- newpath ) GENERIC: vocab-path ( path -- newpath )
GENERIC: absolute-path ( path -- path' ) GENERIC: absolute-path ( path -- path' )
@ -147,9 +151,13 @@ M: string absolute-path
"vocab:" ?head [ "vocab:" ?head [
trim-head-separators vocab-path trim-head-separators vocab-path
absolute-path absolute-path
] [
"~/" ?head [
trim-head-separators home prepend-path
absolute-path
] [ ] [
current-directory get prepend-path current-directory get prepend-path
] if ] if ] if
] if ; ] if ;
M: object normalize-path ( path -- path' ) M: object normalize-path ( path -- path' )
@ -163,6 +171,3 @@ M: pathname absolute-path string>> absolute-path ;
M: pathname <=> [ string>> ] compare ; M: pathname <=> [ string>> ] compare ;
HOOK: home io-backend ( -- dir )
M: object home "" resource-path ;