Merge branch 'master' of git://factorcode.org/git/factor
commit
be12dc3e9f
|
@ -11,7 +11,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
|
||||||
|
|
||||||
: emacsclient ( file line -- )
|
: emacsclient ( file line -- )
|
||||||
[
|
[
|
||||||
{ [ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
|
{
|
||||||
|
[ emacsclient-path get-global ]
|
||||||
|
[ default-emacsclient dup emacsclient-path set-global ]
|
||||||
|
} 0|| ,
|
||||||
"--no-wait" ,
|
"--no-wait" ,
|
||||||
number>string "+" prepend ,
|
number>string "+" prepend ,
|
||||||
,
|
,
|
||||||
|
|
|
@ -2,7 +2,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays continuations deques dlists fry
|
USING: accessors arrays continuations deques dlists fry
|
||||||
io.directories io.files io.files.info io.pathnames kernel
|
io.directories io.files io.files.info io.pathnames kernel
|
||||||
sequences system vocabs.loader ;
|
sequences system vocabs.loader locals math namespaces
|
||||||
|
sorting assocs ;
|
||||||
IN: io.directories.search
|
IN: io.directories.search
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -13,10 +14,10 @@ TUPLE: directory-iterator path bfs queue ;
|
||||||
dup directory-files [ append-path ] with map ;
|
dup directory-files [ append-path ] with map ;
|
||||||
|
|
||||||
: push-directory ( path iter -- )
|
: push-directory ( path iter -- )
|
||||||
[ qualified-directory ] dip [
|
[ qualified-directory ] dip '[
|
||||||
[ queue>> ] [ bfs>> ] bi
|
_ [ queue>> ] [ bfs>> ] bi
|
||||||
[ push-front ] [ push-back ] if
|
[ push-front ] [ push-back ] if
|
||||||
] curry each ;
|
] each ;
|
||||||
|
|
||||||
: <directory-iterator> ( path bfs? -- iterator )
|
: <directory-iterator> ( path bfs? -- iterator )
|
||||||
<dlist> directory-iterator boa
|
<dlist> directory-iterator boa
|
||||||
|
@ -28,12 +29,11 @@ TUPLE: directory-iterator path bfs queue ;
|
||||||
[ over push-directory next-file ] [ nip ] if
|
[ over push-directory next-file ] [ nip ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
|
:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
|
||||||
over next-file [
|
iter next-file [
|
||||||
over call
|
quot call [ iter quot iterate-directory ] unless*
|
||||||
[ 2nip ] [ iterate-directory ] if*
|
|
||||||
] [
|
] [
|
||||||
2drop f
|
f
|
||||||
] if* ; inline recursive
|
] if* ; inline recursive
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
@ -70,4 +70,30 @@ ERROR: file-not-found ;
|
||||||
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
|
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
|
||||||
'[ _ _ find-all-files ] map concat ; inline
|
'[ _ _ find-all-files ] map concat ; inline
|
||||||
|
|
||||||
|
: with-qualified-directory-files ( path quot -- )
|
||||||
|
'[
|
||||||
|
"" directory-files current-directory get
|
||||||
|
'[ _ prepend-path ] map @
|
||||||
|
] with-directory ; inline
|
||||||
|
|
||||||
|
: with-qualified-directory-entries ( path quot -- )
|
||||||
|
'[
|
||||||
|
"" directory-entries current-directory get
|
||||||
|
'[ [ _ prepend-path ] change-name ] map @
|
||||||
|
] with-directory ; inline
|
||||||
|
|
||||||
|
: directory-size ( path -- n )
|
||||||
|
0 swap t [ link-info size-on-disk>> + ] each-file ;
|
||||||
|
|
||||||
|
: directory-usage ( path -- assoc )
|
||||||
|
[
|
||||||
|
[
|
||||||
|
[ name>> dup ] [ directory? ] bi [
|
||||||
|
directory-size
|
||||||
|
] [
|
||||||
|
link-info size-on-disk>>
|
||||||
|
] if
|
||||||
|
] { } map>assoc
|
||||||
|
] with-qualified-directory-entries sort-values ;
|
||||||
|
|
||||||
os windows? [ "io.directories.search.windows" require ] when
|
os windows? [ "io.directories.search.windows" require ] when
|
||||||
|
|
|
@ -5,7 +5,7 @@ vocabs.loader io.files.types ;
|
||||||
IN: io.files.info
|
IN: io.files.info
|
||||||
|
|
||||||
! File info
|
! File info
|
||||||
TUPLE: file-info type size permissions created modified
|
TUPLE: file-info type size size-on-disk permissions created modified
|
||||||
accessed ;
|
accessed ;
|
||||||
|
|
||||||
HOOK: file-info os ( path -- info )
|
HOOK: file-info os ( path -- info )
|
||||||
|
@ -25,4 +25,4 @@ HOOK: file-system-info os ( path -- file-system-info )
|
||||||
{
|
{
|
||||||
{ [ os unix? ] [ "io.files.info.unix." os name>> append ] }
|
{ [ os unix? ] [ "io.files.info.unix." os name>> append ] }
|
||||||
{ [ os windows? ] [ "io.files.info.windows" ] }
|
{ [ os windows? ] [ "io.files.info.windows" ] }
|
||||||
} cond require
|
} cond require
|
||||||
|
|
|
@ -63,6 +63,8 @@ M: unix link-info ( path -- info )
|
||||||
|
|
||||||
M: unix new-file-info ( -- class ) unix-file-info new ;
|
M: unix new-file-info ( -- class ) unix-file-info new ;
|
||||||
|
|
||||||
|
CONSTANT: standard-unix-block-size 512
|
||||||
|
|
||||||
M: unix stat>file-info ( stat -- file-info )
|
M: unix stat>file-info ( stat -- file-info )
|
||||||
[ new-file-info ] dip
|
[ new-file-info ] dip
|
||||||
{
|
{
|
||||||
|
@ -80,6 +82,7 @@ M: unix stat>file-info ( stat -- file-info )
|
||||||
[ stat-st_rdev >>rdev ]
|
[ stat-st_rdev >>rdev ]
|
||||||
[ stat-st_blocks >>blocks ]
|
[ stat-st_blocks >>blocks ]
|
||||||
[ stat-st_blksize >>blocksize ]
|
[ stat-st_blksize >>blocksize ]
|
||||||
|
[ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
||||||
: n>file-type ( n -- type )
|
: n>file-type ( n -- type )
|
||||||
|
|
|
@ -5,11 +5,33 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
|
||||||
windows.time windows accessors alien.c-types combinators
|
windows.time windows accessors alien.c-types combinators
|
||||||
generalizations system alien.strings io.encodings.utf16n
|
generalizations system alien.strings io.encodings.utf16n
|
||||||
sequences splitting windows.errors fry continuations destructors
|
sequences splitting windows.errors fry continuations destructors
|
||||||
calendar ascii combinators.short-circuit ;
|
calendar ascii combinators.short-circuit locals ;
|
||||||
IN: io.files.info.windows
|
IN: io.files.info.windows
|
||||||
|
|
||||||
|
:: round-up-to ( n multiple -- n' )
|
||||||
|
n multiple rem dup 0 = [
|
||||||
|
drop n
|
||||||
|
] [
|
||||||
|
multiple swap - n +
|
||||||
|
] if ;
|
||||||
|
|
||||||
TUPLE: windows-file-info < file-info attributes ;
|
TUPLE: windows-file-info < file-info attributes ;
|
||||||
|
|
||||||
|
: get-compressed-file-size ( path -- n )
|
||||||
|
"DWORD" <c-object> [ GetCompressedFileSize ] keep
|
||||||
|
over INVALID_FILE_SIZE = [
|
||||||
|
win32-error-string throw
|
||||||
|
] [
|
||||||
|
*uint >64bit
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: set-windows-size-on-disk ( file-info path -- file-info )
|
||||||
|
over attributes>> +compressed+ swap member? [
|
||||||
|
get-compressed-file-size
|
||||||
|
] [
|
||||||
|
drop dup size>> 4096 round-up-to
|
||||||
|
] if >>size-on-disk ;
|
||||||
|
|
||||||
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
|
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
|
||||||
[ \ windows-file-info new ] dip
|
[ \ windows-file-info new ] dip
|
||||||
{
|
{
|
||||||
|
@ -79,7 +101,9 @@ TUPLE: windows-file-info < file-info attributes ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: windows file-info ( path -- info )
|
M: windows file-info ( path -- info )
|
||||||
normalize-path get-file-information-stat ;
|
normalize-path
|
||||||
|
[ get-file-information-stat ]
|
||||||
|
[ set-windows-size-on-disk ] bi ;
|
||||||
|
|
||||||
M: windows link-info ( path -- info )
|
M: windows link-info ( path -- info )
|
||||||
file-info ;
|
file-info ;
|
||||||
|
|
|
@ -1139,7 +1139,8 @@ FUNCTION: BOOL GetCommState ( HANDLE hFile, LPDCB lpDCB ) ;
|
||||||
! FUNCTION: GetCommTimeouts
|
! FUNCTION: GetCommTimeouts
|
||||||
! FUNCTION: GetComPlusPackageInstallStatus
|
! FUNCTION: GetComPlusPackageInstallStatus
|
||||||
! FUNCTION: GetCompressedFileSizeA
|
! FUNCTION: GetCompressedFileSizeA
|
||||||
! FUNCTION: GetCompressedFileSizeW
|
FUNCTION: DWORD GetCompressedFileSizeW ( LPCTSTR lpFileName, LPDWORD lpFileSizeHigh ) ;
|
||||||
|
ALIAS: GetCompressedFileSize GetCompressedFileSizeW
|
||||||
FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
||||||
ALIAS: GetComputerName GetComputerNameW
|
ALIAS: GetComputerName GetComputerNameW
|
||||||
FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
||||||
|
|
Loading…
Reference in New Issue