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." }
 | 
			
		||||
{ $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."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 <file-writer>
 | 
			
		||||
    [ 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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ( -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue