diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor index 11ab475f9a..0380d69522 100644 --- a/basis/io/directories/directories-docs.factor +++ b/basis/io/directories/directories-docs.factor @@ -12,7 +12,13 @@ HELP: cd { $description "Changes the current working directory of the Factor process." } { $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 { $description "A variable holding the current directory as an absolute path. Words that use the filesystem do so in relation to this variable." diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 6fbfbbf873..011964f8e1 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,10 +1,9 @@ USING: alien alien.c-types alien.data arrays classes.struct -debugger.threads destructors generic.single io io.directories -io.encodings.8-bit.latin1 io.encodings.ascii +compiler.units continuations destructors generic.single io +io.directories io.encodings.8-bit.latin1 io.encodings.ascii io.encodings.binary io.encodings.string io.files io.files.private io.files.temp io.files.unique kernel make math -sequences specialized-arrays system threads tools.test vocabs -compiler.units ; +sequences specialized-arrays system threads tools.test vocabs ; FROM: specialized-arrays.private => specialized-array-vocab ; SPECIALIZED-ARRAY: int IN: io.files.tests @@ -271,3 +270,20 @@ CONSTANT: pt-array-1 "closing-twice" unique-file ascii [ dispose ] [ dispose ] bi ] 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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 3a2baece25..58f2b8af3b 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.strings init io io.backend io.encodings -io.encodings.utf8 io.files.private io.pathnames kernel -kernel.private namespaces sequences splitting system ; +USING: alien.strings continuations init io io.backend +io.encodings io.encodings.utf8 io.files.private io.pathnames +kernel kernel.private namespaces sequences splitting system ; IN: io.files SYMBOL: +retry+ ! just try the operation again without blocking @@ -70,6 +70,11 @@ HOOK: cwd io-backend ( -- path ) M: object cwd ( -- path ) "." ; +: with-cd ( path quot -- ) + [ [ absolute-path cd ] curry ] dip compose + cwd [ cd ] curry + [ ] cleanup ; inline + PRIVATE> : init-resource-path ( -- )