io.files: add with-cd. Related to #1214.
parent
7a35da738f
commit
aff0150a8c
|
@ -12,7 +12,13 @@ HELP: cd
|
||||||
{ $description "Changes the current working directory of the Factor process." }
|
{ $description "Changes the current working directory of the Factor process." }
|
||||||
{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ;
|
{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ;
|
||||||
|
|
||||||
{ cd cwd current-directory set-current-directory with-directory } related-words
|
HELP: with-cd
|
||||||
|
{ $values
|
||||||
|
{ "path" "a pathname string" } { "quot" quotation }
|
||||||
|
}
|
||||||
|
{ $description "Changes Factor's current working directory (as far as the operating system is concerned). Then, calls the quotation and restores the original directory even if an error is thrown." } ;
|
||||||
|
|
||||||
|
{ cd cwd with-cd current-directory set-current-directory with-directory } related-words
|
||||||
|
|
||||||
HELP: current-directory
|
HELP: current-directory
|
||||||
{ $description "A variable holding the current directory as an absolute path. Words that use the filesystem do so in relation to this variable."
|
{ $description "A variable holding the current directory as an absolute path. Words that use the filesystem do so in relation to this variable."
|
||||||
|
|
|
@ -1,10 +1,9 @@
|
||||||
USING: alien alien.c-types alien.data arrays classes.struct
|
USING: alien alien.c-types alien.data arrays classes.struct
|
||||||
debugger.threads destructors generic.single io io.directories
|
compiler.units continuations destructors generic.single io
|
||||||
io.encodings.8-bit.latin1 io.encodings.ascii
|
io.directories io.encodings.8-bit.latin1 io.encodings.ascii
|
||||||
io.encodings.binary io.encodings.string io.files
|
io.encodings.binary io.encodings.string io.files
|
||||||
io.files.private io.files.temp io.files.unique kernel make math
|
io.files.private io.files.temp io.files.unique kernel make math
|
||||||
sequences specialized-arrays system threads tools.test vocabs
|
sequences specialized-arrays system threads tools.test vocabs ;
|
||||||
compiler.units ;
|
|
||||||
FROM: specialized-arrays.private => specialized-array-vocab ;
|
FROM: specialized-arrays.private => specialized-array-vocab ;
|
||||||
SPECIALIZED-ARRAY: int
|
SPECIALIZED-ARRAY: int
|
||||||
IN: io.files.tests
|
IN: io.files.tests
|
||||||
|
@ -271,3 +270,20 @@ CONSTANT: pt-array-1
|
||||||
"closing-twice" unique-file ascii <file-writer>
|
"closing-twice" unique-file ascii <file-writer>
|
||||||
[ dispose ] [ dispose ] bi
|
[ dispose ] [ dispose ] bi
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Test with-cd
|
||||||
|
{ t } [
|
||||||
|
cwd
|
||||||
|
"resource:core/" [ "hi" print ] with-cd
|
||||||
|
cwd =
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ t } [
|
||||||
|
cwd
|
||||||
|
[ "resource:core/" [ "nick cage" throw ] with-cd ] [ drop ] recover
|
||||||
|
cwd =
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"resource:core/" [ "nick cage" throw ] with-cd
|
||||||
|
] [ "nick cage" = ] must-fail-with
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
|
! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.strings init io io.backend io.encodings
|
USING: alien.strings continuations init io io.backend
|
||||||
io.encodings.utf8 io.files.private io.pathnames kernel
|
io.encodings io.encodings.utf8 io.files.private io.pathnames
|
||||||
kernel.private namespaces sequences splitting system ;
|
kernel kernel.private namespaces sequences splitting system ;
|
||||||
IN: io.files
|
IN: io.files
|
||||||
|
|
||||||
SYMBOL: +retry+ ! just try the operation again without blocking
|
SYMBOL: +retry+ ! just try the operation again without blocking
|
||||||
|
@ -70,6 +70,11 @@ HOOK: cwd io-backend ( -- path )
|
||||||
|
|
||||||
M: object cwd ( -- path ) "." ;
|
M: object cwd ( -- path ) "." ;
|
||||||
|
|
||||||
|
: with-cd ( path quot -- )
|
||||||
|
[ [ absolute-path cd ] curry ] dip compose
|
||||||
|
cwd [ cd ] curry
|
||||||
|
[ ] cleanup ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: init-resource-path ( -- )
|
: init-resource-path ( -- )
|
||||||
|
|
Loading…
Reference in New Issue