io.directories: cleanup and some performance improvements with move/copy.
parent
2f325e4fee
commit
b519b52fa3
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators destructors io io.backend
|
||||
io.encodings.binary io.files io.files.types io.pathnames
|
||||
kernel namespaces sequences system vocabs.loader fry
|
||||
vocabs ;
|
||||
USING: accessors arrays combinators combinators.short-circuit
|
||||
destructors fry io io.backend io.encodings.binary io.files
|
||||
io.files.types io.pathnames kernel namespaces sequences
|
||||
system vocabs vocabs.loader ;
|
||||
IN: io.directories
|
||||
|
||||
: set-current-directory ( path -- )
|
||||
|
@ -16,16 +16,15 @@ IN: io.directories
|
|||
HOOK: make-directory io-backend ( path -- )
|
||||
|
||||
: make-directories ( path -- )
|
||||
normalize-path trim-tail-separators {
|
||||
{ [ dup "." = ] [ ] }
|
||||
{ [ dup root-directory? ] [ ] }
|
||||
{ [ dup empty? ] [ ] }
|
||||
{ [ dup exists? ] [ ] }
|
||||
[
|
||||
dup parent-directory make-directories
|
||||
dup make-directory
|
||||
]
|
||||
} cond drop ;
|
||||
normalize-path trim-tail-separators dup {
|
||||
[ "." = ]
|
||||
[ root-directory? ]
|
||||
[ empty? ]
|
||||
[ exists? ]
|
||||
} 1|| [
|
||||
dup parent-directory make-directories
|
||||
dup make-directory
|
||||
] unless drop ;
|
||||
|
||||
! Listing directories
|
||||
TUPLE: directory-entry name type ;
|
||||
|
@ -40,7 +39,7 @@ HOOK: (directory-entries) os ( path -- seq )
|
|||
[ name>> { "." ".." } member? not ] filter ;
|
||||
|
||||
: directory-files ( path -- seq )
|
||||
directory-entries [ name>> ] map ;
|
||||
directory-entries [ name>> ] map! ;
|
||||
|
||||
: with-directory-entries ( path quot -- )
|
||||
'[ "" directory-entries @ ] with-directory ; inline
|
||||
|
@ -66,7 +65,7 @@ HOOK: move-file io-backend ( from to -- )
|
|||
to-directory move-file ;
|
||||
|
||||
: move-files-into ( files to -- )
|
||||
'[ _ move-file-into ] each ;
|
||||
to-directory '[ _ move-file ] each ;
|
||||
|
||||
! Copying files
|
||||
HOOK: copy-file io-backend ( from to -- )
|
||||
|
@ -83,7 +82,7 @@ M: object copy-file
|
|||
to-directory copy-file ;
|
||||
|
||||
: copy-files-into ( files to -- )
|
||||
'[ _ copy-file-into ] each ;
|
||||
to-directory '[ _ copy-file ] each ;
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "io.directories.unix" require ] }
|
||||
|
|
|
@ -8,11 +8,11 @@ IN: io.directories.search
|
|||
|
||||
: qualified-directory-entries ( path -- seq )
|
||||
absolute-path
|
||||
dup directory-entries [ [ append-path ] change-name ] with map ;
|
||||
dup directory-entries [ [ append-path ] change-name ] with map! ;
|
||||
|
||||
: qualified-directory-files ( path -- seq )
|
||||
absolute-path
|
||||
dup directory-files [ append-path ] with map ;
|
||||
dup directory-files [ append-path ] with map! ;
|
||||
|
||||
: with-qualified-directory-files ( path quot -- )
|
||||
'[ "" qualified-directory-files @ ] with-directory ; inline
|
||||
|
@ -110,7 +110,7 @@ ERROR: file-not-found path bfs? quot ;
|
|||
: find-by-extensions ( path extensions -- seq )
|
||||
[ >lower ] map
|
||||
'[ >lower _ [ tail? ] with any? ] find-all-files ;
|
||||
|
||||
|
||||
: find-by-extension ( path extension -- seq )
|
||||
1array find-by-extensions ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue