io.files.temp: allow changing of current temp and cache directory.
parent
47ae304ff7
commit
33b6c0426d
basis/io/files/temp
|
@ -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