io.directories: implement cross-platform truncate-file.

diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor
index 82b46a9393ad842772baa356f93bec663cdeccd7..ffe6747c99295c12ebcff1063e2bc345ae95a3f5 100644 (file)
--- a/basis/io/directories/directories-docs.factor
+++ b/basis/io/directories/directories-docs.factor
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io.files.private io.pathnames
-quotations sequences ;
+math quotations sequences ;
 IN: io.directories
 
 HELP: cwd
@@ -102,6 +102,11 @@ HELP: touch-file
 { $description "Updates the modification time of a file or directory. If the file does not exist, creates a new, empty file." }
 { $errors "Throws an error if the file could not be touched." } ;
 
+HELP: truncate-file
+{ $values { "path" "a pathname string" } { "n" integer } }
+{ $description "Set the length of the file to " { $snippet "n" } " bytes. If the file was previously longer, the extra data is lost. If the file was previously shorter, the behavior is platform-dependent on whether the file is extended with zeros (Unix) or the contents of the extended portion are undefined (Windows)." }
+{ $errors "Throws an error if the file does not exist or the truncate operation fails." } ;
+
 HELP: move-file
 { $values { "from" "a pathname string" } { "to" "a pathname string" } }
 { $description "Moves or renames a file. This operation is not guaranteed to be atomic. In particular, if you attempt to move a file across volumes, this will copy the file and then delete the original in a nontransactional manner." }

diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor
index 6f6b00dc75f44a7d0111ca4b76058cee7e457a7d..b5ea21f909a0d7dda05c5c3ff19e53bc6417a590 100644 (file)
--- a/basis/io/directories/directories.factor
+++ b/basis/io/directories/directories.factor
@@ -199,10 +199,10 @@ ERROR: sequence-expected obj ;
 : find-files-larger-than ( path size -- seq )
     '[ link-info size>> _ > ] find-files ;
 
-! Touching files
 HOOK: touch-file io-backend ( path -- )
 
-! Deleting files
+HOOK: truncate-file io-backend ( path n -- )
+
 HOOK: delete-file io-backend ( path -- )
 
 HOOK: delete-directory io-backend ( path -- )
@@ -213,8 +213,8 @@ HOOK: delete-directory io-backend ( path -- )
 : to-directory ( from to -- from to' )
     over file-name append-path ;
 
-! Moving and renaming files
 HOOK: move-file io-backend ( from to -- )
+
 HOOK: move-file-atomically io-backend ( from to -- )
 
 : move-file-into ( from to -- )
@@ -223,7 +223,6 @@ HOOK: move-file-atomically io-backend ( from to -- )
 : move-files-into ( files to -- )
     '[ _ move-file-into ] each ;
 
-! Copying files
 HOOK: copy-file io-backend ( from to -- )
 
 M: object copy-file

diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor
index 8b46303552c9cff6204bd660b7064e01e380c5c4..1cd3a9e4348428107e58e3c0b082109b2ed2583f 100644 (file)
--- a/basis/io/directories/unix/unix.factor
+++ b/basis/io/directories/unix/unix.factor
@@ -17,6 +17,9 @@ M: unix touch-file
         touch-mode file-mode open-file close-file
     ] if ;
 
+M: unix truncate-file
+    [ normalize-path ] dip [ truncate ] unix-system-call drop ;
+
 M: unix move-file-atomically
     [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
 

diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index e9339c1a2655c85dc6c9c152c0a4697a091ed6a2..a0dc7680d282060aae2efc3225a7e7fbe6d5412c 100644 (file)
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -8,11 +8,15 @@ fry continuations classes.struct windows.time ;
 IN: io.directories.windows
 
 M: windows touch-file
-    [
-        normalize-path
-        maybe-create-file [ &dispose ] dip
-        [ drop ] [ handle>> f now dup (set-file-times) ] if
-    ] with-destructors ;
+    normalize-path maybe-create-file '[
+        _ [ drop ] [ handle>> f now dup (set-file-times) ] if
+    ] with-disposal ;
+
+M: windows truncate-file
+    [ normalize-path open-file ] dip '[
+        [ _ 0 FILE_END set-file-pointer ]
+        [ set-end-of-file ] bi
+    ] with-disposal ;
 
 M: windows move-file
     [ normalize-path ] bi@ MoveFile win32-error=0/f ;

diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor
index f7f5e29c8662c034ea628bb08c15fc5baa72b274..02c2a4f98a1ef0137c6d605be0114a14daaccae8 100644 (file)
--- a/basis/io/files/windows/windows.factor
+++ b/basis/io/files/windows/windows.factor
@@ -252,10 +252,13 @@ M: windows init-stdio
     OPEN_ALWAYS 0 open-file
     GetLastError ERROR_ALREADY_EXISTS = not ;
 
-: set-file-pointer ( handle length method -- )
+: set-file-pointer ( win32-file length method -- )
     [ [ handle>> ] dip d>w/w LONG <ref> ] dip SetFilePointer
     INVALID_SET_FILE_POINTER = [ "SetFilePointer failed" throw ] when ;
 
+: set-end-of-file ( win32-file -- )
+    handle>> SetEndOfFile zero? [ windows-error ] unless ;
+
 M: windows (file-reader)
     open-read <input-port> ;
 

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index bcb1c4a7c357101b46319d5221de5d6229c825dd..4cb43044b9b71aec4a56b3fad04ebcf8b0a63a6f 100644 (file)
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -68,8 +68,6 @@ M: unix open-file [ open ] unix-system-call ;
 
 : make-fifo ( path mode -- ) [ mkfifo ] unix-system-call drop ;
 
-: truncate-file ( path n -- ) [ truncate ] unix-system-call drop ;
-
 : touch ( filename -- ) f [ utime ] unix-system-call drop ;
 
 : change-file-times ( filename access modification -- )