Merge branch 'master' of git://factorcode.org/git/factor

basis/editors/emacs/emacs.factor

@@ -11,7 +11,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
 
 : emacsclient ( file line -- )
     [
-        { [ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
+        {
+            [ emacsclient-path get-global ]
+            [ default-emacsclient dup emacsclient-path set-global ]
+        } 0|| ,
         "--no-wait" ,
         number>string "+" prepend ,
         ,

basis/io/directories/search/search.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays continuations deques dlists fry
 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
 
 <PRIVATE
@@ -13,10 +14,10 @@ TUPLE: directory-iterator path bfs queue ;
     dup directory-files [ append-path ] with map ;
 
 : push-directory ( path iter -- )
-    [ qualified-directory ] dip [
+    [ qualified-directory ] dip '[
-        [ queue>> ] [ bfs>> ] bi
+        _ [ queue>> ] [ bfs>> ] bi
         [ push-front ] [ push-back ] if
-    ] curry each ;
+    ] each ;
 
 : <directory-iterator> ( path bfs? -- iterator )
     <dlist> directory-iterator boa
@@ -28,12 +29,11 @@ TUPLE: directory-iterator path bfs queue ;
         [ over push-directory next-file ] [ nip ] 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
 
 PRIVATE>
@@ -70,4 +70,30 @@ ERROR: file-not-found ;
 : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
     '[ _ _ 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

basis/io/files/info/info.factor

@@ -5,7 +5,7 @@ vocabs.loader io.files.types ;
 IN: io.files.info
 
 ! File info
-TUPLE: file-info type size permissions created modified
+TUPLE: file-info type size size-on-disk permissions created modified
 accessed ;
 
 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 windows? ] [ "io.files.info.windows" ] }
-} cond require
+} cond require

basis/io/files/info/unix/unix.factor

@@ -63,6 +63,8 @@ M: unix link-info ( path -- info )
 
 M: unix new-file-info ( -- class ) unix-file-info new ;
 
+CONSTANT: standard-unix-block-size 512
+
 M: unix stat>file-info ( stat -- file-info )
     [ new-file-info ] dip
     {
@@ -80,6 +82,7 @@ M: unix stat>file-info ( stat -- file-info )
         [ stat-st_rdev >>rdev ]
         [ stat-st_blocks >>blocks ]
         [ stat-st_blksize >>blocksize ]
+        [ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
     } cleave ;
 
 : n>file-type ( n -- type )

basis/io/files/info/windows/windows.factor

@@ -5,11 +5,33 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
 windows.time windows accessors alien.c-types combinators
 generalizations system alien.strings io.encodings.utf16n
 sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit ;
+calendar ascii combinators.short-circuit locals ;
 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 ;
 
+: 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 )
     [ \ windows-file-info new ] dip
     {
@@ -79,7 +101,9 @@ TUPLE: windows-file-info < file-info attributes ;
     ] if ;
 
 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 )
     file-info ;

basis/windows/kernel32/kernel32.factor

@@ -1139,7 +1139,8 @@ FUNCTION: BOOL GetCommState ( HANDLE hFile, LPDCB lpDCB ) ;
 ! FUNCTION: GetCommTimeouts
 ! FUNCTION: GetComPlusPackageInstallStatus
 ! FUNCTION: GetCompressedFileSizeA
-! FUNCTION: GetCompressedFileSizeW
+FUNCTION: DWORD GetCompressedFileSizeW ( LPCTSTR lpFileName, LPDWORD lpFileSizeHigh ) ;
+ALIAS: GetCompressedFileSize GetCompressedFileSizeW
 FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ;
 ALIAS: GetComputerName GetComputerNameW
 FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ;