From bbaa8b95bdf9c1808458679fa6e42f64d15f917a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 13:30:12 -0600 Subject: [PATCH 1/7] mounted -> file-systems --- basis/unix/statfs/linux/linux.factor | 2 +- basis/unix/statfs/macosx/macosx.factor | 2 +- basis/unix/statfs/statfs.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index aae8d09145..d2d892cfb7 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -32,7 +32,7 @@ frequency pass-number ; ] with-scope [ mtab-csv>mtab-entry ] map ; -M: linux mounted +M: linux file-systems parse-mtab [ [ mount-point>> file-system-info ] keep { diff --git a/basis/unix/statfs/macosx/macosx.factor b/basis/unix/statfs/macosx/macosx.factor index 6bf09fcdc0..7c30c4b9d4 100644 --- a/basis/unix/statfs/macosx/macosx.factor +++ b/basis/unix/statfs/macosx/macosx.factor @@ -122,7 +122,7 @@ TUPLE: macosx-file-system-info < file-system-info block-size io-size blocks blocks-free blocks-available files files-free file-system-id owner type-id flags filesystem-subtype ; -M: macosx mounted ( -- array ) +M: macosx file-systems ( -- array ) f dup 0 getmntinfo64 dup io-error [ *void* ] dip "statfs64" heap-size [ * memory>byte-array ] keep group diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index e77ef37b0f..db31dabfa2 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -8,7 +8,7 @@ TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) -HOOK: mounted os ( -- array ) +HOOK: file-systems os ( -- array ) os { { linux [ "unix.statfs.linux" require ] } From c860ab78b6b45697ebcf06fb80b013ff796cbd4e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 13:41:34 -0600 Subject: [PATCH 2/7] removed duplicate file-system-info definition. oops --- basis/unix/statfs/statfs.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index db31dabfa2..85734d660d 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -4,8 +4,6 @@ USING: sequences system vocabs.loader combinators accessors kernel math.order sorting ; IN: unix.statfs -TUPLE: file-system-info root-directory total-free-size total-size ; - HOOK: >file-system-info os ( struct -- statfs ) HOOK: file-systems os ( -- array ) From 78ab09d8bbbd021789600a1c489efb95901ae362 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 14:04:05 -0600 Subject: [PATCH 3/7] move file-systems word to core --- basis/unix/statfs/statfs.factor | 2 -- core/io/files/files.factor | 2 ++ 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor index db31dabfa2..ee6ef83430 100644 --- a/basis/unix/statfs/statfs.factor +++ b/basis/unix/statfs/statfs.factor @@ -8,8 +8,6 @@ TUPLE: file-system-info root-directory total-free-size total-size ; HOOK: >file-system-info os ( struct -- statfs ) -HOOK: file-systems os ( -- array ) - os { { linux [ "unix.statfs.linux" require ] } { macosx [ "unix.statfs.macosx" require ] } diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 9899f5a014..ca8125d936 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -184,6 +184,8 @@ SYMBOL: +unknown+ ! File-system +HOOK: file-systems os ( -- array ) + TUPLE: file-system-info device-name mount-point type free-space ; HOOK: file-system-info os ( path -- file-system-info ) From 146340690f812b1ed4ebb45ce27900169d8271da Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 15:17:35 -0600 Subject: [PATCH 4/7] implement file-systems on windows --- basis/io/windows/files/files.factor | 24 +++++++++++++++++++----- basis/windows/kernel32/kernel32.factor | 9 ++++++--- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 3952299543..b9b5baa0ca 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -276,18 +276,31 @@ M: winnt file-system-info ( path -- file-system-info ) swap >>type swap >>mount-point ; +: volume>paths ( string -- array ) + 16384 "ushort" tuck dup length + 0 dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [ + win32-error-string throw + ] [ + *uint "ushort" heap-size * head + utf16n alien>string CHAR: \0 split + ] if ; + : find-first-volume ( -- string handle ) MAX_PATH 1+ dup length dupd FindFirstVolume dup win32-error=0/f [ utf16n alien>string ] dip ; -: find-next-volume ( handle -- string ) +: find-next-volume ( handle -- string/f ) MAX_PATH 1+ dup length - [ FindNextVolume win32-error=0/f ] 2keep drop - utf16n alien>string ; + over [ FindNextVolume ] dip swap 0 = [ + GetLastError ERROR_NO_MORE_FILES = + [ drop f ] [ win32-error ] if + ] [ + utf16n alien>string + ] if ; -: mounted ( -- array ) +M: winnt file-systems ( -- array ) find-first-volume [ '[ @@ -296,7 +309,8 @@ M: winnt file-system-info ( path -- file-system-info ) [ drop ] produce swap prefix ] - ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup + [ volume>paths ] map ; : file-times ( path -- timestamp timestamp timestamp ) [ diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index eb90fb522e..462377e85c 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -954,7 +954,8 @@ ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW ! FUNCTION: GetDllDirectoryA ! FUNCTION: GetDllDirectoryW ! FUNCTION: GetDriveTypeA -! FUNCTION: GetDriveTypeW +FUNCTION: UINT GetDriveTypeW ( LPCTSTR lpRootPathName ) ; +ALIAS: GetDriveType GetDriveTypeW FUNCTION: void* GetEnvironmentStringsW ( ) ; ! FUNCTION: GetEnvironmentStringsA ALIAS: GetEnvironmentStrings GetEnvironmentStringsW @@ -999,7 +1000,7 @@ FUNCTION: DWORD GetLastError ( ) ; ! FUNCTION: GetLocaleInfoA ! FUNCTION: GetLocaleInfoW ! FUNCTION: GetLocalTime -! FUNCTION: GetLogicalDrives +FUNCTION: DWORD GetLogicalDrives ( ) ; ! FUNCTION: GetLogicalDriveStringsA ! FUNCTION: GetLogicalDriveStringsW ! FUNCTION: GetLongPathNameA @@ -1129,7 +1130,9 @@ ALIAS: GetVolumeInformation GetVolumeInformationW ! FUNCTION: GetVolumeNameForVolumeMountPointW ! FUNCTION: GetVolumePathNameA ! FUNCTION: GetVolumePathNamesForVolumeNameA -! FUNCTION: GetVolumePathNamesForVolumeNameW +FUNCTION: BOOL GetVolumePathNamesForVolumeNameW ( LPCTSTR lpszVolumeName, LPTSTR lpszVolumePathNames, DWORD cchBufferLength, PDWORD lpcchReturnLength ) ; +ALIAS: GetVolumePathNamesForVolumeName GetVolumePathNamesForVolumeNameW + ! FUNCTION: GetVolumePathNameW ! FUNCTION: GetWindowsDirectoryA FUNCTION: UINT GetWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ; From 1f85b7ec1459062f40df5faa7ac40eb714946b32 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 15:35:17 -0600 Subject: [PATCH 5/7] catch errors for windows file-systems word and return a tuple with just a mount point this happens on empty floppy disk drives --- basis/io/windows/files/files.factor | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index b9b5baa0ca..e3b96b98d8 100755 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -300,7 +300,7 @@ M: winnt file-system-info ( path -- file-system-info ) utf16n alien>string ] if ; -M: winnt file-systems ( -- array ) +: find-volumes ( -- array ) find-first-volume [ '[ @@ -309,8 +309,14 @@ M: winnt file-systems ( -- array ) [ drop ] produce swap prefix ] - ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup - [ volume>paths ] map ; + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; + +M: winnt file-systems ( -- array ) + find-volumes [ volume>paths ] map + concat [ + [ file-system-info ] + [ drop winnt-file-system-info new swap >>mount-point ] recover + ] map ; : file-times ( path -- timestamp timestamp timestamp ) [ From fa282c5053fef5c55a7cbf1c949ea0df2e84f70a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 15:37:32 -0600 Subject: [PATCH 6/7] remove duplicate using --- basis/unix/statfs/linux/linux.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index d2d892cfb7..43d5a99cd1 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types combinators kernel io.files unix.stat +USING: alien.c-types combinators kernel unix.stat math accessors system unix io.backend layouts vocabs.loader sequences csv io.streams.string io.encodings.utf8 namespaces unix.statfs io.files ; From 0edfc83d50aaae91e5f9f7b8d6d1640faadd9e7d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 11 Nov 2008 15:41:27 -0600 Subject: [PATCH 7/7] document file-systems --- core/io/files/files-docs.factor | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 9a85688202..80b515b13f 100644 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -1,5 +1,5 @@ -USING: help.markup help.syntax io strings - io.backend io.files.private quotations ; +USING: help.markup help.syntax io strings arrays io.backend +io.files.private quotations ; IN: io.files ARTICLE: "file-streams" "Reading and writing files" @@ -323,6 +323,10 @@ HELP: with-directory-files { $values { "path" "a pathname string" } { "quot" quotation } } { $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ; +HELP: file-systems +{ $values { "array" array } } +{ $description "Returns an array of " { $link file-system-info } " objects returned by iterating the mount points and calling " { $link file-system-info } " on each." } ; + HELP: file-system-info { $values { "path" "a pathname string" }