io.files.temp: allow changing of current temp and cache directory.
							parent
							
								
									47ae304ff7
								
							
						
					
					
						commit
						33b6c0426d
					
				| 
						 | 
				
			
			@ -22,22 +22,18 @@ FUNCTION: id NSSearchPathForDirectoriesInDomains (
 | 
			
		|||
 | 
			
		||||
CONSTANT: factor-bundle-name "org.factorcode.Factor"
 | 
			
		||||
 | 
			
		||||
: (make-factor-bundle-subdir) ( path -- path )
 | 
			
		||||
    factor-bundle-name append-path dup make-directories ;
 | 
			
		||||
: factor-bundle-subdir ( path -- path )
 | 
			
		||||
    factor-bundle-name append-path ;
 | 
			
		||||
 | 
			
		||||
: (first-existing) ( paths -- path )
 | 
			
		||||
: first-existing ( paths -- path )
 | 
			
		||||
    [ exists? ] map-find nip
 | 
			
		||||
    [ "no user cache directory found" throw ] unless* ; inline
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: (temp-directory) ( -- path )
 | 
			
		||||
    NSTemporaryDirectory CF>string (make-factor-bundle-subdir) ;
 | 
			
		||||
M: macosx default-temp-directory
 | 
			
		||||
    NSTemporaryDirectory CF>string factor-bundle-subdir ;
 | 
			
		||||
 | 
			
		||||
M: macosx temp-directory (temp-directory) ;
 | 
			
		||||
 | 
			
		||||
: (cache-directory) ( -- path )
 | 
			
		||||
M: macosx default-cache-directory
 | 
			
		||||
    NSCachesDirectory NSUserDomainMask 1 NSSearchPathForDirectoriesInDomains
 | 
			
		||||
    plist> (first-existing) (make-factor-bundle-subdir) ;
 | 
			
		||||
 | 
			
		||||
M: macosx cache-directory (cache-directory) ;
 | 
			
		||||
    plist> first-existing factor-bundle-subdir ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,12 +4,14 @@ IN: io.files.temp
 | 
			
		|||
ARTICLE: "io.files.temp" "Temporary files"
 | 
			
		||||
"Pathnames relative to the system's temporary file directory:"
 | 
			
		||||
{ $subsections
 | 
			
		||||
    current-temp-directory
 | 
			
		||||
    temp-file
 | 
			
		||||
    temp-directory
 | 
			
		||||
    with-temp-directory
 | 
			
		||||
}
 | 
			
		||||
"Pathnames relative to Factor's cache directory, used to store persistent intermediate files and resources:"
 | 
			
		||||
{ $subsections
 | 
			
		||||
    current-cache-directory
 | 
			
		||||
    cache-file
 | 
			
		||||
    cache-directory
 | 
			
		||||
    with-cache-directory
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,10 +1,18 @@
 | 
			
		|||
! (c)2012 Joe Groff bsd license
 | 
			
		||||
USING: combinators io.directories io.pathnames kernel system
 | 
			
		||||
vocabs ;
 | 
			
		||||
USING: combinators io.directories io.pathnames kernel
 | 
			
		||||
namespaces system vocabs ;
 | 
			
		||||
IN: io.files.temp
 | 
			
		||||
 | 
			
		||||
HOOK: temp-directory os ( -- path )
 | 
			
		||||
HOOK: cache-directory os ( -- path )
 | 
			
		||||
HOOK: default-temp-directory os ( -- path )
 | 
			
		||||
 | 
			
		||||
SYMBOL: current-temp-directory
 | 
			
		||||
 | 
			
		||||
current-temp-directory [
 | 
			
		||||
    default-temp-directory dup make-directories
 | 
			
		||||
] initialize
 | 
			
		||||
 | 
			
		||||
: temp-directory ( -- path )
 | 
			
		||||
    current-temp-directory get ;
 | 
			
		||||
 | 
			
		||||
: temp-file ( name -- path )
 | 
			
		||||
    temp-directory prepend-path ;
 | 
			
		||||
| 
						 | 
				
			
			@ -12,6 +20,17 @@ HOOK: cache-directory os ( -- path )
 | 
			
		|||
: with-temp-directory ( quot -- )
 | 
			
		||||
    [ temp-directory ] dip with-directory ; inline
 | 
			
		||||
 | 
			
		||||
HOOK: default-cache-directory os ( -- path )
 | 
			
		||||
 | 
			
		||||
SYMBOL: current-cache-directory
 | 
			
		||||
 | 
			
		||||
current-cache-directory [
 | 
			
		||||
    default-cache-directory dup make-directories
 | 
			
		||||
] initialize
 | 
			
		||||
 | 
			
		||||
: cache-directory ( -- path )
 | 
			
		||||
    current-cache-directory get ;
 | 
			
		||||
 | 
			
		||||
: cache-file ( name -- path )
 | 
			
		||||
    cache-directory prepend-path ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,14 +1,7 @@
 | 
			
		|||
! (c)2012 Joe Groff bsd license
 | 
			
		||||
USING: io.directories io.files.temp io.pathnames kernel memoize
 | 
			
		||||
system ;
 | 
			
		||||
USING: io.files.temp io.pathnames system ;
 | 
			
		||||
IN: io.files.temp.unix
 | 
			
		||||
 | 
			
		||||
MEMO: (temp-directory) ( -- path )
 | 
			
		||||
    "/tmp/factor-temp" dup make-directories ;
 | 
			
		||||
M: unix default-temp-directory "/tmp/factor-temp" ;
 | 
			
		||||
 | 
			
		||||
M: unix temp-directory (temp-directory) ;
 | 
			
		||||
 | 
			
		||||
MEMO: (cache-directory) ( -- path )
 | 
			
		||||
    home ".factor-cache" append-path dup make-directories ;
 | 
			
		||||
 | 
			
		||||
M: unix cache-directory (cache-directory) ;
 | 
			
		||||
M: unix default-cache-directory home ".factor-cache" append-path ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -9,7 +9,7 @@ IN: io.files.temp.windows
 | 
			
		|||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: (get-temp-directory) ( -- path )
 | 
			
		||||
: get-temp-directory ( -- path )
 | 
			
		||||
    MAX_PATH 1 + dup WCHAR <c-array> [ GetTempPath ] keep
 | 
			
		||||
    swap win32-error=0/f
 | 
			
		||||
    alien>native-string ;
 | 
			
		||||
| 
						 | 
				
			
			@ -25,13 +25,9 @@ PRIVATE>
 | 
			
		|||
    [ SHGetFolderPath ] keep
 | 
			
		||||
    swap check-ole32-error alien>native-string ;
 | 
			
		||||
 | 
			
		||||
M: windows default-temp-directory
 | 
			
		||||
    get-temp-directory "factorcode.org\\Factor" append-path ;
 | 
			
		||||
 | 
			
		||||
MEMO: (temp-directory) ( -- path )
 | 
			
		||||
    (get-temp-directory) "factorcode.org\\Factor" append-path dup make-directories ;
 | 
			
		||||
M: windows default-cache-directory
 | 
			
		||||
    get-appdata-directory "factorcode.org\\Factor" append-path ;
 | 
			
		||||
 | 
			
		||||
M: windows temp-directory (temp-directory) ;
 | 
			
		||||
 | 
			
		||||
MEMO: (cache-directory) ( -- path )
 | 
			
		||||
    get-appdata-directory "factorcode.org\\Factor" append-path dup make-directories ;
 | 
			
		||||
 | 
			
		||||
M: windows cache-directory (cache-directory) ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue