From fef5ebec013bf686b267f80cfd42c95d1781cc62 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 27 Feb 2008 14:59:15 -0600
Subject: [PATCH 1/3] io.files overhaul
---
core/io/files/files-docs.factor | 55 ++++-
core/io/files/files-tests.factor | 97 +++++++--
core/io/files/files.factor | 199 +++++++++++--------
core/listener/listener.factor | 6 +-
core/syntax/syntax-docs.factor | 2 +-
core/system/system-docs.factor | 2 +-
extra/help/handbook/handbook.factor | 15 +-
extra/io/unix/files/files.factor | 21 +-
extra/io/windows/nt/files/files.factor | 3 +-
extra/io/windows/nt/monitors/monitors.factor | 4 +-
extra/io/windows/windows.factor | 4 +-
extra/logging/server/server.factor | 6 +-
extra/tools/deploy/macosx/macosx.factor | 28 +--
extra/tools/deploy/windows/windows.factor | 5 +-
extra/unix/unix.factor | 2 +
vm/os-windows.c | 2 +-
16 files changed, 295 insertions(+), 156 deletions(-)
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index 185fa1436b..743a2d1b99 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -3,14 +3,32 @@ io.backend io.files.private ;
IN: io.files
ARTICLE: "file-streams" "Reading and writing files"
+"File streams:"
{ $subsection <file-reader> }
{ $subsection <file-writer> }
{ $subsection <file-appender> }
+"Utility combinators:"
+{ $subsection with-file-reader }
+{ $subsection with-file-writer }
+{ $subsection with-file-appender } ;
+
+ARTICLE: "pathnames" "Pathname manipulation"
"Pathname manipulation:"
{ $subsection parent-directory }
{ $subsection file-name }
{ $subsection last-path-separator }
{ $subsection path+ }
+"Pathnames relative to Factor's install directory:"
+{ $subsection resource-path }
+{ $subsection ?resource-path }
+"Pathnames relative to Factor's temporary files directory:"
+{ $subsection temp-directory }
+{ $subsection temp-file }
+"Pathname presentations:"
+{ $subsection pathname }
+{ $subsection <pathname> } ;
+
+ARTICLE: "file-system" "The file system"
"File system meta-data:"
{ $subsection exists? }
{ $subsection directory? }
@@ -19,24 +37,43 @@ ARTICLE: "file-streams" "Reading and writing files"
{ $subsection stat }
"Directory listing:"
{ $subsection directory }
-"File management:"
-{ $subsection delete-file }
+{ $subsection directory* }
+"Creating directories:"
{ $subsection make-directory }
+{ $subsection make-directories }
+"Deleting files:"
+{ $subsection delete-file }
{ $subsection delete-directory }
+{ $subsection delete-tree }
+"Moving files:"
+{ $subsection move-file }
+{ $subsection move-file-to }
+"Copying files:"
+{ $subsection copy-file }
+{ $subsection copy-file-to }
+{ $subsection copy-tree }
"Current and home directories:"
-{ $subsection home }
{ $subsection cwd }
{ $subsection cd }
-"Pathnames relative to the Factor install directory:"
-{ $subsection resource-path }
-{ $subsection ?resource-path }
-"Pathname presentations:"
-{ $subsection pathname }
-{ $subsection <pathname> }
+{ $subsection with-directory }
+{ $subsection home }
{ $see-also "os" } ;
+ARTICLE: "io.files" "Basic file operations"
+"The " { $vocab-link "io.files" } " vocabulary provides basic support for working with files."
+{ $subsection "file-streams" }
+{ $subsection "pathnames" }
+{ $subsection "file-system" } ;
ABOUT: "file-streams"
+HELP: path-separator?
+{ $values { "ch" "a code point" } { "?" "a boolean" } }
+{ $description "Tests if the code point is a platform-specific path separator." }
+{ $examples
+ "On Unix:"
+ { $example "USING: io.files prettyprint ;" "CHAR: / path-separator? ." "t" }
+} ;
+
HELP: <file-reader>
{ $values { "path" "a pathname string" } { "stream" "an input stream" } }
{ $description "Outputs an input stream for reading from the specified pathname." }
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index a111070151..92e148a854 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -6,63 +6,118 @@ USING: tools.test io.files io threads kernel continuations ;
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
- "test-foo.txt" resource-path [
+ "test-foo.txt" temp-file [
"Hello world." print
] with-file-writer
] unit-test
[ ] [
- "test-foo.txt" resource-path <file-appender> [
+ "test-foo.txt" temp-file <file-appender> [
"Hello appender." print
] with-stream
] unit-test
[ ] [
- "test-bar.txt" resource-path <file-appender> [
+ "test-bar.txt" temp-file <file-appender> [
"Hello appender." print
] with-stream
] unit-test
[ "Hello world.\nHello appender.\n" ] [
- "test-foo.txt" resource-path file-contents
+ "test-foo.txt" temp-file file-contents
] unit-test
[ "Hello appender.\n" ] [
- "test-bar.txt" resource-path file-contents
+ "test-bar.txt" temp-file file-contents
] unit-test
-[ ] [ "test-foo.txt" resource-path delete-file ] unit-test
+[ ] [ "test-foo.txt" temp-file delete-file ] unit-test
-[ ] [ "test-bar.txt" resource-path delete-file ] unit-test
+[ ] [ "test-bar.txt" temp-file delete-file ] unit-test
-[ f ] [ "test-foo.txt" resource-path exists? ] unit-test
+[ f ] [ "test-foo.txt" temp-file exists? ] unit-test
-[ f ] [ "test-bar.txt" resource-path exists? ] unit-test
+[ f ] [ "test-bar.txt" temp-file exists? ] unit-test
-[ ] [ "test-blah" resource-path make-directory ] unit-test
+[ ] [ "test-blah" temp-file make-directory ] unit-test
[ ] [
- "test-blah/fooz" resource-path <file-writer> dispose
+ "test-blah/fooz" temp-file <file-writer> dispose
] unit-test
[ t ] [
- "test-blah/fooz" resource-path exists?
+ "test-blah/fooz" temp-file exists?
] unit-test
-[ ] [ "test-blah/fooz" resource-path delete-file ] unit-test
+[ ] [ "test-blah/fooz" temp-file delete-file ] unit-test
-[ ] [ "test-blah" resource-path delete-directory ] unit-test
+[ ] [ "test-blah" temp-file delete-directory ] unit-test
-[ f ] [ "test-blah" resource-path exists? ] unit-test
+[ f ] [ "test-blah" temp-file exists? ] unit-test
-[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" resource-path delete-file ] unit-test
+[ ] [ "test-quux.txt" temp-file delete-file ] unit-test
-[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" "quux-test.txt" [ resource-path ] 2apply rename-file ] unit-test
-[ t ] [ "quux-test.txt" resource-path exists? ] unit-test
+[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test
+[ t ] [ "quux-test.txt" temp-file exists? ] unit-test
-[ ] [ "quux-test.txt" resource-path delete-file ] unit-test
+[ ] [ "quux-test.txt" temp-file delete-file ] unit-test
+[ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test
+
+[ ] [
+ "delete-tree-test/a/b/c/d" temp-file
+ [ "Hi" print ] with-file-writer
+] unit-test
+
+[ ] [
+ "delete-tree-test" temp-file delete-tree
+] unit-test
+
+[ ] [
+ "copy-tree-test/a/b/c" temp-file make-directories
+] unit-test
+
+[ ] [
+ "copy-tree-test/a/b/c/d" temp-file
+ [ "Foobar" write ] with-file-writer
+] unit-test
+
+[ ] [
+ "copy-tree-test" temp-file
+ "copy-destination" temp-file copy-tree
+] unit-test
+
+[ "Foobar" ] [
+ "copy-destination/a/b/c/d" temp-file file-contents
+] unit-test
+
+[ ] [
+ "copy-destination" temp-file delete-tree
+] unit-test
+
+[ ] [
+ "copy-tree-test" temp-file
+ "copy-destination" temp-file copy-tree-to
+] unit-test
+
+[ "Foobar" ] [
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file file-contents
+] unit-test
+
+[ ] [
+ "copy-destination/copy-tree-test/a/b/c/d" temp-file "" temp-file copy-file-to
+] unit-test
+
+[ "Foobar" ] [
+ "d" temp-file file-contents
+] unit-test
+
+[ ] [ "d" temp-file delete-file ] unit-test
+
+[ ] [ "copy-destination" temp-file delete-tree ] unit-test
+
+[ ] [ "copy-tree-test" temp-file delete-tree ] unit-test
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 7dbe8c229e..7e14ffc4e3 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -5,30 +5,9 @@ USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings assocs arrays definitions
system combinators splitting sbufs continuations ;
-HOOK: cd io-backend ( path -- )
-
-HOOK: cwd io-backend ( -- path )
-
-HOOK: <file-reader> io-backend ( path -- stream )
-
-HOOK: <file-writer> io-backend ( path -- stream )
-
-HOOK: <file-appender> io-backend ( path -- stream )
-
-HOOK: delete-file io-backend ( path -- )
-
-HOOK: rename-file io-backend ( from to -- )
-
-HOOK: make-directory io-backend ( path -- )
-
-HOOK: delete-directory io-backend ( path -- )
-
+! Pathnames
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
-HOOK: root-directory? io-backend ( path -- ? )
-
-M: object root-directory? ( path -- ? ) path-separator? ;
-
: right-trim-separators ( str -- newstr )
[ path-separator? ] right-trim ;
@@ -39,33 +18,15 @@ M: object root-directory? ( path -- ? ) path-separator? ;
>r right-trim-separators "/" r>
left-trim-separators 3append ;
-: stat ( path -- directory? permissions length modified )
- normalize-pathname (stat) ;
-
-: file-length ( path -- n ) stat 4array third ;
-
-: file-modified ( path -- n ) stat >r 3drop r> ; inline
-
-: exists? ( path -- ? ) file-modified >boolean ;
-
-: directory? ( path -- ? ) stat 3drop ;
-
-: special-directory? ( name -- ? )
- { "." ".." } member? ;
-
-: fixup-directory ( path seq -- newseq )
- [
- dup string?
- [ tuck path+ directory? 2array ] [ nip ] if
- ] with map
- [ first special-directory? not ] subset ;
-
-: directory ( path -- seq )
- normalize-directory dup (directory) fixup-directory ;
-
: last-path-separator ( path -- n ? )
[ length 1- ] keep [ path-separator? ] find-last* ;
+HOOK: root-directory? io-backend ( path -- ? )
+
+M: object root-directory? ( path -- ? ) path-separator? ;
+
+: special-directory? ( name -- ? ) { "." ".." } member? ;
+
TUPLE: no-parent-directory path ;
: no-parent-directory ( path -- * )
@@ -89,15 +50,30 @@ TUPLE: no-parent-directory path ;
{ [ t ] [ drop ] }
} cond ;
-: resource-path ( path -- newpath )
- \ resource-path get [ image parent-directory ] unless*
- swap path+ ;
+! File metadata
+: stat ( path -- directory? permissions length modified )
+ normalize-pathname (stat) ;
-: ?resource-path ( path -- newpath )
- "resource:" ?head [ resource-path ] when ;
+: file-length ( path -- n ) stat drop 2nip ;
-: resource-exists? ( path -- ? )
- ?resource-path exists? ;
+: file-modified ( path -- n ) stat >r 3drop r> ;
+
+: file-permissions ( path -- perm ) stat 2drop nip ;
+
+: exists? ( path -- ? ) file-modified >boolean ;
+
+: directory? ( path -- ? ) stat 3drop ;
+
+! Current working directory
+HOOK: cd io-backend ( path -- )
+
+HOOK: cwd io-backend ( -- path )
+
+: with-directory ( path quot -- )
+ swap cd cwd [ cd ] curry [ ] cleanup ; inline
+
+! Creating directories
+HOOK: make-directory io-backend ( path -- )
: make-directories ( path -- )
normalize-pathname right-trim-separators {
@@ -111,35 +87,102 @@ TUPLE: no-parent-directory path ;
] }
} cond drop ;
+! Directory listings
+: fixup-directory ( path seq -- newseq )
+ [
+ dup string?
+ [ tuck path+ directory? 2array ] [ nip ] if
+ ] with map
+ [ first special-directory? not ] subset ;
+
+: directory ( path -- seq )
+ normalize-directory dup (directory) fixup-directory ;
+
+: directory* ( path -- seq )
+ dup directory [ first2 >r path+ r> 2array ] with map ;
+
+! Touching files
+HOOK: touch-file io-backend ( path -- )
+
+! Deleting files
+HOOK: delete-file io-backend ( path -- )
+
+HOOK: delete-directory io-backend ( path -- )
+
+: (delete-tree) ( path dir? -- )
+ [
+ dup directory* [ (delete-tree) ] assoc-each
+ delete-directory
+ ] [ delete-file ] if ;
+
+: delete-tree ( path -- )
+ dup directory? (delete-tree) ;
+
+: to-directory over file-name path+ ;
+
+! Moving and renaming files
+HOOK: move-file io-backend ( from to -- )
+
+: move-file-to ( from to -- )
+ to-directory move-file ;
+
+: move-files-to ( files to -- )
+ [ move-file-to ] curry each ;
+
+! Copying files
HOOK: copy-file io-backend ( from to -- )
-M: object copy-file
- dup parent-directory make-directories
- <file-writer> [
- swap <file-reader> [
- swap stream-copy
- ] with-disposal
- ] with-disposal ;
+: copy-file-to ( from to -- )
+ to-directory copy-file ;
-: copy-directory ( from to -- )
- dup make-directories
- >r dup directory swap r> [
- >r >r first r> over path+ r> rot path+ copy-file
- ] 2curry each ;
+DEFER: copy-tree-to
-: home ( -- dir )
- {
- { [ winnt? ] [ "USERPROFILE" os-env ] }
- { [ wince? ] [ "" resource-path ] }
- { [ unix? ] [ "HOME" os-env ] }
- } cond ;
+: copy-tree ( from to -- )
+ over directory? [
+ dup make-directories
+ >r dup directory swap r> [
+ >r swap first path+ r> copy-tree-to
+ ] 2curry each
+ ] [
+ copy-file
+ ] if ;
+: copy-tree-to ( from to -- )
+ to-directory copy-tree ;
+
+! Special paths
+: resource-path ( path -- newpath )
+ \ resource-path get [ image parent-directory ] unless*
+ swap path+ ;
+
+: ?resource-path ( path -- newpath )
+ "resource:" ?head [ resource-path ] when ;
+
+: resource-exists? ( path -- ? )
+ ?resource-path exists? ;
+
+: temp-directory ( -- path )
+ "temp" resource-path
+ dup exists? not
+ [ dup make-directory ]
+ when ;
+
+: temp-file ( name -- path ) temp-directory swap path+ ;
+
+! Pathname presentations
TUPLE: pathname string ;
C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
+! Streams
+HOOK: <file-reader> io-backend ( path -- stream )
+
+HOOK: <file-writer> io-backend ( path -- stream )
+
+HOOK: <file-appender> io-backend ( path -- stream )
+
: file-lines ( path -- seq ) <file-reader> lines ;
: file-contents ( path -- str )
@@ -155,10 +198,10 @@ M: pathname <=> [ pathname-string ] compare ;
: with-file-appender ( path quot -- )
>r <file-appender> r> with-stream ; inline
-: temp-directory ( -- path )
- "temp" resource-path
- dup exists? not
- [ dup make-directory ]
- when ;
-
-: temp-file ( name -- path ) temp-directory swap path+ ;
\ No newline at end of file
+! Home directory
+: home ( -- dir )
+ {
+ { [ winnt? ] [ "USERPROFILE" os-env ] }
+ { [ wince? ] [ "" resource-path ] }
+ { [ unix? ] [ "HOME" os-env ] }
+ } cond ;
\ No newline at end of file
diff --git a/core/listener/listener.factor b/core/listener/listener.factor
index 110f0d3ee1..fe1471716d 100755
--- a/core/listener/listener.factor
+++ b/core/listener/listener.factor
@@ -62,11 +62,7 @@ M: duplex-stream stream-read-quot
[ quit-flag off ]
[ listen until-quit ] if ; inline
-: print-banner ( -- )
- "Factor #" write build number>string write
- " on " write os write "/" write cpu print ;
-
: listener ( -- )
- print-banner [ until-quit ] with-interactive-vocabs ;
+ [ until-quit ] with-interactive-vocabs ;
MAIN: listener
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index 95a00f3801..eeb3f85962 100755
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -163,7 +163,7 @@ ARTICLE: "syntax-byte-vectors" "Byte vector syntax"
ARTICLE: "syntax-pathnames" "Pathname syntax"
{ $subsection POSTPONE: P" }
-"Pathnames are documented in " { $link "file-streams" } "." ;
+"Pathnames are documented in " { $link "pathnames" } "." ;
ARTICLE: "syntax-literals" "Literals"
"Many different types of objects can be constructed at parse time via literal syntax. Numbers are a special case since support for reading them is built-in to the parser. All other literals are constructed via parsing words."
diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor
index bdd04307df..facfd2b48d 100755
--- a/core/system/system-docs.factor
+++ b/core/system/system-docs.factor
@@ -29,7 +29,7 @@ ARTICLE: "os" "System interface"
{ $subsection millis }
"Exiting the Factor VM:"
{ $subsection exit }
-{ $see-also "file-streams" "network-streams" "io.launcher" "io.mmap" } ;
+{ $see-also "io.files" "network-streams" "io.launcher" "io.mmap" } ;
ABOUT: "os"
diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor
index 422d7ef1e8..6660ddf218 100755
--- a/extra/help/handbook/handbook.factor
+++ b/extra/help/handbook/handbook.factor
@@ -171,23 +171,24 @@ ARTICLE: "collections" "Collections"
USING: io.sockets io.launcher io.mmap io.monitors ;
-ARTICLE: "io" "Input and output"
+ARTICLE: "io" "Input and output"
+{ $heading "Streams" }
{ $subsection "streams" }
-"External streams:"
-{ $subsection "file-streams" }
-{ $subsection "network-streams" }
"Wrapper streams:"
{ $subsection "io.streams.duplex" }
{ $subsection "io.streams.lines" }
{ $subsection "io.streams.plain" }
{ $subsection "io.streams.string" }
-"Stream utilities:"
+"Utilities:"
{ $subsection "stream-binary" }
{ $subsection "styles" }
-"Advanced features:"
-{ $subsection "io.launcher" }
+{ $heading "Files" }
+{ $subsection "io.files" }
{ $subsection "io.mmap" }
{ $subsection "io.monitors" }
+{ $heading "Other features" }
+{ $subsection "network-streams" }
+{ $subsection "io.launcher" }
{ $subsection "io.timeouts" } ;
ARTICLE: "tools" "Developer tools"
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 3bf0e3f897..41a6cb140f 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -37,7 +37,15 @@ M: unix-io <file-writer> ( path -- stream )
M: unix-io <file-appender> ( path -- stream )
open-append <writer> ;
-M: unix-io rename-file ( from to -- )
+: touch-mode
+ { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
+
+M: unix-io touch-file ( path -- )
+ touch-mode file-mode open
+ dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
+ close ;
+
+M: unix-io move-file ( from to -- )
rename io-error ;
M: unix-io delete-file ( path -- )
@@ -48,3 +56,14 @@ M: unix-io make-directory ( path -- )
M: unix-io delete-directory ( path -- )
rmdir io-error ;
+
+: (copy-file) ( from to -- )
+ dup parent-directory make-directories
+ <file-writer> [
+ swap <file-reader> [
+ swap stream-copy
+ ] with-disposal
+ ] with-disposal ;
+
+M: unix-io copy-file ( from to -- )
+ over file-permissions >r (copy-file) r> chmod io-error ;
diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor
index 3541243016..dda94da892 100755
--- a/extra/io/windows/nt/files/files.factor
+++ b/extra/io/windows/nt/files/files.factor
@@ -59,7 +59,8 @@ M: windows-nt-io root-directory? ( path -- ? )
} cond ;
M: windows-nt-io normalize-pathname ( string -- string )
- dup string? [ "pathname must be a string" throw ] unless
+ dup string? [ "Pathname must be a string" throw ] unless
+ dup empty? [ "Empty pathname" throw ] when
{ { CHAR: / CHAR: \\ } } substitute
cwd swap windows-path+
[ "/\\." member? ] right-trim
diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor
index eff3c250dc..d14dff8c22 100755
--- a/extra/io/windows/nt/monitors/monitors.factor
+++ b/extra/io/windows/nt/monitors/monitors.factor
@@ -5,7 +5,7 @@ io.windows.nt.backend kernel math windows windows.kernel32
windows.types libc assocs alien namespaces continuations
io.monitors io.monitors.private io.nonblocking io.buffers
io.files io.timeouts io sequences hashtables sorting arrays
-combinators ;
+combinators math.bitfields ;
IN: io.windows.nt.monitors
: open-directory ( path -- handle )
@@ -13,7 +13,7 @@ IN: io.windows.nt.monitors
share-mode
f
OPEN_EXISTING
- FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor
+ { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags
f
CreateFile
dup invalid-handle?
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index ee3f744bb0..9f2f2db0a5 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -28,7 +28,7 @@ HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- )
M: windows-io normalize-directory ( string -- string )
- "\\" ?tail drop "\\*" append ;
+ normalize-pathname "\\" ?tail drop "\\*" append ;
: share-mode ( -- fixnum )
{
@@ -121,7 +121,7 @@ M: windows-io <file-writer> ( path -- stream )
M: windows-io <file-appender> ( path -- stream )
open-append <win32-file> <writer> ;
-M: windows-io rename-file ( from to -- )
+M: windows-io move-file ( from to -- )
[ normalize-pathname ] 2apply MoveFile win32-error=0/f ;
M: windows-io delete-file ( path -- )
diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor
index 94d112583a..99f637f4a0 100755
--- a/extra/logging/server/server.factor
+++ b/extra/logging/server/server.factor
@@ -68,11 +68,11 @@ SYMBOL: log-files
: delete-oldest keep-logs log# ?delete-file ;
-: ?rename-file ( old new -- )
- over exists? [ rename-file ] [ 2drop ] if ;
+: ?move-file ( old new -- )
+ over exists? [ move-file ] [ 2drop ] if ;
: advance-log ( path n -- )
- [ 1- log# ] 2keep log# ?rename-file ;
+ [ 1- log# ] 2keep log# ?move-file ;
: rotate-log ( service -- )
dup close-log
diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor
index eb1a4af4a7..f331a687a0 100755
--- a/extra/tools/deploy/macosx/macosx.factor
+++ b/extra/tools/deploy/macosx/macosx.factor
@@ -1,36 +1,22 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files io.launcher kernel namespaces sequences
-system tools.deploy.backend tools.deploy.config assocs
-hashtables prettyprint io.unix.backend cocoa
-cocoa.application cocoa.classes cocoa.plists qualified ;
-QUALIFIED: unix
+USING: io io.files kernel namespaces sequences system
+tools.deploy.backend tools.deploy.config assocs hashtables
+prettyprint cocoa cocoa.application cocoa.classes cocoa.plists ;
IN: tools.deploy.macosx
-: touch ( path -- )
- { "touch" } swap add try-process ;
-
-: rm ( path -- )
- { "rm" "-rf" } swap add try-process ;
-
: bundle-dir ( -- dir )
vm parent-directory parent-directory ;
: copy-bundle-dir ( name dir -- )
- bundle-dir over path+ -rot
- >r "Contents" path+ r> path+ copy-directory ;
-
-: chmod ( path perms -- )
- unix:chmod io-error ;
+ bundle-dir swap path+ swap "Contents" path+ copy-tree ;
: copy-vm ( executable bundle-name -- vm )
- "Contents/MacOS/" path+ swap path+ vm swap
- [ copy-file ] keep
- [ OCT: 755 chmod ] keep ;
+ "Contents/MacOS/" path+ swap path+ vm swap copy-file ;
: copy-fonts ( name -- )
"fonts/" resource-path
- swap "Contents/Resources/fonts/" path+ copy-directory ;
+ swap "Contents/Resources/" path+ copy-tree ;
: print-app-plist ( executable bundle-name -- )
[
@@ -75,7 +61,7 @@ M: macosx-deploy-implementation deploy* ( vocab -- )
".app deploy tool" assert.app
"." resource-path cd
dup deploy-config [
- bundle-name rm
+ bundle-name delete-tree
[ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep
namespace make-deploy-image
diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor
index 00dbc2e4df..f78b4d030e 100755
--- a/extra/tools/deploy/windows/windows.factor
+++ b/extra/tools/deploy/windows/windows.factor
@@ -9,8 +9,7 @@ IN: tools.deploy.windows
swap path+ ".exe" append vm swap [ copy-file ] keep ;
: copy-fonts ( bundle-name -- )
- "fonts/" resource-path
- swap "fonts/" path+ copy-directory ;
+ "fonts/" resource-path swap copy-tree ;
: copy-dlls ( bundle-name -- )
{
@@ -18,7 +17,7 @@ IN: tools.deploy.windows
"zlib1.dll"
"factor-nt.dll"
} [
- dup resource-path -rot path+ copy-file
+ resource-path swap copy-file-to
] with each ;
: create-exe-dir ( vocab bundle-name -- vm )
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index 7df41069e0..e8716ee074 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -102,6 +102,8 @@ C-STRUCT: timespec
: MAP_FAILED -1 <alien> ; inline
+: EEXIST 17 ; inline
+
! ! ! Unix functions
LIBRARY: factor
FUNCTION: int err_no ( ) ;
diff --git a/vm/os-windows.c b/vm/os-windows.c
index a60339c578..e28debd449 100755
--- a/vm/os-windows.c
+++ b/vm/os-windows.c
@@ -174,7 +174,7 @@ DEFINE_PRIMITIVE(read_dir)
GROWABLE_ADD(result,pair);
}
while (FindNextFile(dir, &find_data));
- CloseHandle(dir);
+ FindClose(dir);
}
UNREGISTER_ROOT(result);
From 9c82591ca621053ce527aa6de7304020e197e9a6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Wed, 27 Feb 2008 16:31:13 -0600
Subject: [PATCH 2/3] Documentation improvements
---
core/io/encodings/authors.txt | 1 +
core/io/encodings/tags.txt | 1 +
core/io/files/files-docs.factor | 164 +++++++++++++++----
core/io/files/files.factor | 6 +
core/io/io-docs.factor | 68 ++++++--
core/system/system-docs.factor | 4 +-
extra/calendar/authors.txt | 2 +-
extra/calendar/format/summary.txt | 1 +
extra/calendar/model/summary.txt | 1 +
extra/calendar/summary.txt | 2 +-
extra/concurrency/flags/flags-docs.factor | 2 +-
extra/farkup/authors.txt | 1 +
extra/farkup/summary.txt | 1 +
extra/farkup/tags.txt | 1 +
extra/help/cookbook/cookbook.factor | 2 +-
extra/io/launcher/summary.txt | 2 +-
extra/io/server/summary.txt | 1 +
extra/io/timeouts/summary.txt | 1 +
extra/io/unix/files/files.factor | 2 +-
extra/regexp/summary.txt | 1 +
extra/tools/deploy/macosx/macosx.factor | 2 +-
extra/tools/deploy/windows/windows.factor | 15 +-
extra/tools/disassembler/disassembler.factor | 4 +-
extra/wrap/authors.txt | 1 +
extra/wrap/summary.txt | 1 +
extra/wrap/tags.txt | 1 +
26 files changed, 223 insertions(+), 65 deletions(-)
create mode 100644 core/io/encodings/tags.txt
create mode 100644 extra/calendar/format/summary.txt
create mode 100644 extra/calendar/model/summary.txt
create mode 100644 extra/farkup/authors.txt
create mode 100644 extra/farkup/summary.txt
create mode 100644 extra/farkup/tags.txt
create mode 100644 extra/io/server/summary.txt
create mode 100644 extra/io/timeouts/summary.txt
create mode 100644 extra/regexp/summary.txt
create mode 100644 extra/wrap/authors.txt
create mode 100644 extra/wrap/summary.txt
create mode 100644 extra/wrap/tags.txt
diff --git a/core/io/encodings/authors.txt b/core/io/encodings/authors.txt
index 1901f27a24..33616a2d6a 100755
--- a/core/io/encodings/authors.txt
+++ b/core/io/encodings/authors.txt
@@ -1 +1,2 @@
+Daniel Ehrenberg
Slava Pestov
diff --git a/core/io/encodings/tags.txt b/core/io/encodings/tags.txt
new file mode 100644
index 0000000000..8e27be7d61
--- /dev/null
+++ b/core/io/encodings/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index 743a2d1b99..c918641912 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -1,5 +1,5 @@
USING: help.markup help.syntax io io.styles strings
-io.backend io.files.private ;
+io.backend io.files.private quotations ;
IN: io.files
ARTICLE: "file-streams" "Reading and writing files"
@@ -28,19 +28,40 @@ ARTICLE: "pathnames" "Pathname manipulation"
{ $subsection pathname }
{ $subsection <pathname> } ;
-ARTICLE: "file-system" "The file system"
-"File system meta-data:"
-{ $subsection exists? }
-{ $subsection directory? }
-{ $subsection file-length }
-{ $subsection file-modified }
-{ $subsection stat }
+ARTICLE: "directories" "Directories"
+"Current and home directories:"
+{ $subsection cwd }
+{ $subsection cd }
+{ $subsection with-directory }
+{ $subsection home }
"Directory listing:"
{ $subsection directory }
{ $subsection directory* }
"Creating directories:"
{ $subsection make-directory }
-{ $subsection make-directories }
+{ $subsection make-directories } ;
+
+ARTICLE: "fs-meta" "File meta-data"
+{ $subsection exists? }
+{ $subsection directory? }
+{ $subsection file-length }
+{ $subsection file-modified }
+{ $subsection stat } ;
+
+ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
+"Operations for deleting and copying files come in two forms:"
+{ $list
+ { "Words named " { $snippet { $emphasis "operation" } "-file" } " which work on regular files only." }
+ { "Words named " { $snippet { $emphasis "operation" } "-tree" } " works on directory trees recursively, and also accepts regular files." }
+}
+"The operations for moving and copying files come in three flavors:"
+{ $list
+ { "A word named " { $snippet { $emphasis "operation" } } " which takes a source and destination path." }
+ { "A word named " { $snippet { $emphasis "operation" } "-to" } " which takes a source path and destination directory. The destination file will be stored in the destination directory and will have the same file name as the source path." }
+ { "A word named " { $snippet { $emphasis "operation" } "s-to" } " which takes a sequence of source paths and destination directory." }
+}
+"Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file."
+$nl
"Deleting files:"
{ $subsection delete-file }
{ $subsection delete-directory }
@@ -48,23 +69,27 @@ ARTICLE: "file-system" "The file system"
"Moving files:"
{ $subsection move-file }
{ $subsection move-file-to }
+{ $subsection move-files-to }
"Copying files:"
{ $subsection copy-file }
{ $subsection copy-file-to }
+{ $subsection copy-files-to }
+"Copying directory trees recursively:"
{ $subsection copy-tree }
-"Current and home directories:"
-{ $subsection cwd }
-{ $subsection cd }
-{ $subsection with-directory }
-{ $subsection home }
-{ $see-also "os" } ;
+{ $subsection copy-tree-to }
+{ $subsection copy-trees-to }
+"On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ;
ARTICLE: "io.files" "Basic file operations"
"The " { $vocab-link "io.files" } " vocabulary provides basic support for working with files."
-{ $subsection "file-streams" }
{ $subsection "pathnames" }
-{ $subsection "file-system" } ;
-ABOUT: "file-streams"
+{ $subsection "file-streams" }
+{ $subsection "fs-meta" }
+{ $subsection "directories" }
+{ $subsection "delete-move-copy" }
+{ $see-also "os" } ;
+
+ABOUT: "io.files"
HELP: path-separator?
{ $values { "ch" "a code point" } { "?" "a boolean" } }
@@ -74,6 +99,19 @@ HELP: path-separator?
{ $example "USING: io.files prettyprint ;" "CHAR: / path-separator? ." "t" }
} ;
+HELP: parent-directory
+{ $values { "path" "a pathname string" } { "parent" "a pathname string" } }
+{ $description "Strips the last component off a pathname." }
+{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
+
+HELP: file-name
+{ $values { "path" "a pathname string" } { "string" string } }
+{ $description "Outputs the last component of a pathname string." }
+{ $examples
+ { "\"/usr/bin/gcc\" file-name ." "\"gcc\"" }
+ { "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
+} ;
+
HELP: <file-reader>
{ $values { "path" "a pathname string" } { "stream" "an input stream" } }
{ $description "Outputs an input stream for reading from the specified pathname." }
@@ -114,7 +152,12 @@ HELP: cd
{ $description "Changes the current working directory of the Factor process." }
{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;
-{ cd cwd } related-words
+{ cd cwd with-directory } related-words
+
+HELP: with-directory
+{ $values { "path" "a pathname string" } { "quot" quotation } }
+{ $description "Changes the current working directory for the duration of a quotation's execution." }
+{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;
HELP: stat ( path -- directory? permissions length modified )
{ $values { "path" "a pathname string" } { "directory?" "boolean indicating if the file is a directory" } { "permissions" "a Unix permission bitmap (0 on Windows)" } { "length" "the length in bytes as an integer" } { "modified" "the last modification time, as milliseconds since midnight, January 1st 1970 GMT" } }
@@ -145,6 +188,11 @@ HELP: directory
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
+HELP: directory*
+{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
+{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
+{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
+
HELP: file-length
{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
{ $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ;
@@ -153,19 +201,6 @@ HELP: file-modified
{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
{ $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
-HELP: parent-directory
-{ $values { "path" "a pathname string" } { "parent" "a pathname string" } }
-{ $description "Strips the last component off a pathname." }
-{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
-
-HELP: file-name
-{ $values { "path" "a pathname string" } { "string" string } }
-{ $description "Outputs the last component of a pathname string." }
-{ $examples
- { "\"/usr/bin/gcc\" file-name ." "\"gcc\"" }
- { "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
-} ;
-
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
{ $description "Resolve a path relative to the Factor source code location. This first checks if the " { $link resource-path } " variable is set to a path, and if not, uses the parent directory of the current image." } ;
@@ -205,7 +240,72 @@ HELP: make-directory
{ $description "Creates a directory." }
{ $errors "Throws an error if the directory could not be created." } ;
+HELP: make-directories
+{ $values { "path" "a pathname string" } }
+{ $description "Creates a directory and any parent directories which do not yet exist." }
+{ $errors "Throws an error if the directories could not be created." } ;
+
HELP: delete-directory
{ $values { "path" "a pathname string" } }
{ $description "Deletes a directory. The directory must be empty." }
{ $errors "Throws an error if the directory could not be deleted." } ;
+
+HELP: touch-file
+{ $values { "path" "a pathname string" } }
+{ $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: delete-tree
+{ $values { "path" "a pathname string" } }
+{ $description "Deletes a file or directory, recursing into subdirectories." }
+{ $errors "Throws an error if the deletion fails." }
+{ $warning "Misuse of this word can lead to catastrophic data loss." } ;
+
+HELP: move-file
+{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
+{ $description "Moves or renames a file." }
+{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
+
+HELP: move-file-to
+{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
+{ $description "Moves a file to another directory without renaming it." }
+{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
+
+HELP: move-files-to
+{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
+{ $description "Moves a set of files to another directory." }
+{ $errors "Throws an error if the file does not exist or if the move operation fails." } ;
+
+HELP: copy-file
+{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
+{ $description "Copies a file." }
+{ $notes "This operation attempts to preserve the original file's attributes, however not all attributes may be preserved." }
+{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
+
+HELP: copy-file-to
+{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
+{ $description "Copies a file to another directory." }
+{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
+
+HELP: copy-files-to
+{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
+{ $description "Copies a set of files to another directory." }
+{ $errors "Throws an error if the file does not exist or if the copy operation fails." } ;
+
+HELP: copy-tree
+{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
+{ $description "Copies a directory tree recursively." }
+{ $notes "This operation attempts to preserve original file attributes, however not all attributes may be preserved." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+HELP: copy-tree-to
+{ $values { "from" "a pathname string" } { "to" "a directory pathname string" } }
+{ $description "Copies a directory tree to another directory, recursively." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+HELP: copy-trees-to
+{ $values { "files" "a sequence of pathname strings" } { "to" "a directory pathname string" } }
+{ $description "Copies a set of directory trees to another directory, recursively." }
+{ $errors "Throws an error if the copy operation fails." } ;
+
+
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 7e14ffc4e3..64e4f0f49a 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -135,6 +135,9 @@ HOOK: copy-file io-backend ( from to -- )
: copy-file-to ( from to -- )
to-directory copy-file ;
+: copy-files-to ( files to -- )
+ [ copy-file-to ] curry each ;
+
DEFER: copy-tree-to
: copy-tree ( from to -- )
@@ -150,6 +153,9 @@ DEFER: copy-tree-to
: copy-tree-to ( from to -- )
to-directory copy-tree ;
+: copy-trees-to ( files to -- )
+ [ copy-tree-to ] curry each ;
+
! Special paths
: resource-path ( path -- newpath )
\ resource-path get [ image parent-directory ] unless*
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index 9c73a3b2b1..0986196e8d 100755
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -5,6 +5,8 @@ IN: io
ARTICLE: "stream-protocol" "Stream protocol"
"The stream protocol consists of a large number of generic words, many of which are optional."
$nl
+"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in a " { $link with-stream } ". This leads more simpler, more reusable and more robust code."
+$nl
"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
$nl
"Three words are required for input streams:"
@@ -25,7 +27,35 @@ $nl
{ $see-also "io.timeouts" } ;
ARTICLE: "stdio" "The default stream"
-"Various words take an implicit stream parameter from a variable to reduce stack shuffling."
+"Most I/O code only operates on one stream at a time. The " { $emphasis "default stream" } " is an implicit parameter used by many I/O words designed for this particular use-case. Using this idiom improves code in three ways:"
+{ $list
+ { "Code becomes simpler because there is no need to keep a stream around on the stack." }
+ { "Code becomes more robust because " { $link with-stream } " automatically closes the stream if there is an error." }
+ { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-stream } " to specify the source or destination for I/O operations." }
+}
+"For example, here is a program which reads the first line of a file, converts it to an integer, then reads that many characters, and splits them into groups of 16:"
+{ $code
+ "USING: continuations kernel io io.files math.parser splitting ;"
+ "\"data.txt\" <file-reader>"
+ "dup stream-readln number>string over stream-read 16 group"
+ "swap dispose"
+}
+"This code has two problems: it has some unnecessary stack shuffling, and if either " { $link stream-readln } " or " { $link stream-read } " throws an I/O error, the stream is not closed because " { $link dispose } " is never reached. So we can add a call to " { $link with-disposal } " to ensure the stream is always closed:"
+{ $code
+ "USING: continuations kernel io io.files math.parser splitting ;"
+ "\"data.txt\" <file-reader> ["
+ " dup stream-readln number>string over stream-read"
+ " 16 group"
+ "] with-disposal"
+}
+"This code is robust however it is more complex than it needs to be since. This is where the default stream words come in; using them, the above can be rewritten as follows:"
+{ $code
+ "USING: continuations kernel io io.files math.parser splitting ;"
+ "\"data.txt\" <file-reader> ["
+ " readln number>string read 16 group"
+ "] with-stream"
+}
+"The default stream is stored in a dynamically-scoped variable:"
{ $subsection stdio }
"Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user."
{ $subsection read1 }
@@ -65,6 +95,8 @@ $nl
ARTICLE: "streams" "Streams"
"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of characters. Streams also support formatted output, which may be used to present styled text in a manner independent of output medium."
+$nl
+"A stream can either be passed around on the stack or bound to a dynamic variable and used as an implicit " { $emphasis "default stream" } "."
{ $subsection "stream-protocol" }
{ $subsection "stdio" }
{ $subsection "stream-utils" }
@@ -75,42 +107,50 @@ ABOUT: "streams"
HELP: stream-readln
{ $values { "stream" "an input stream" } { "str" string } }
{ $contract "Reads a line of input from the stream. Outputs " { $link f } " on stream exhaustion." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link readln } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-read1
{ $values { "stream" "an input stream" } { "ch/f" "a character or " { $link f } } }
{ $contract "Reads a character of input from the stream. Outputs " { $link f } " on stream exhaustion." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link read1 } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-read
{ $values { "n" "a non-negative integer" } { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
{ $contract "Reads " { $snippet "n" } " characters of input from the stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link read1 } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-read-until
{ $values { "seps" string } { "stream" "an input stream" } { "str/f" "a string or " { $link f } } { "sep/f" "a character or " { $link f } } }
{ $contract "Reads characters from the stream, until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link read-until } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-write1
{ $values { "ch" "a character" } { "stream" "an output stream" } }
{ $contract "Writes a character of output to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link write1 } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-write
{ $values { "str" string } { "stream" "an output stream" } }
{ $contract "Writes a string of output to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link write } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-flush
{ $values { "stream" "an output stream" } }
{ $contract "Waits for any pending output to complete." }
{ $notes "With many output streams, written output is buffered and not sent to the underlying resource until either the buffer is full, or this word is called." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link flush } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-nl
{ $values { "stream" "an output stream" } }
{ $contract "Writes a line terminator. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link nl } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-format
@@ -118,6 +158,7 @@ HELP: stream-format
{ $contract "Writes formatted text to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output."
$nl
"The " { $snippet "style" } " hashtable holds character style information. See " { $link "character-styles" } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link format } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-block-stream
@@ -127,7 +168,7 @@ $nl
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
$nl
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
-{ $notes "Instead of calling this word directly, use " { $link with-nesting } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link with-nesting } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-write-table
@@ -135,13 +176,13 @@ HELP: stream-write-table
{ $contract "Prints a table of cells produced by " { $link with-cell } "."
$nl
"The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
-{ $notes "Instead of calling this word directly, use " { $link tabular-output } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link tabular-output } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-cell-stream
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
{ $contract "Creates an output stream which writes to a table cell object." }
-{ $notes "Instead of calling this word directly, use " { $link tabular-output } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link with-cell } "; see " { $link "stdio" } "." }
$io-error ;
HELP: make-span-stream
@@ -149,12 +190,13 @@ HELP: make-span-stream
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
-{ $notes "Instead of calling this word directly, use " { $link with-style } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link with-style } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-print
{ $values { "str" string } { "stream" "an output stream" } }
{ $description "Writes a newline-terminated string." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link print } "; see " { $link "stdio" } "." }
$io-error ;
HELP: stream-copy
@@ -167,17 +209,17 @@ HELP: stdio
HELP: readln
{ $values { "str/f" "a string or " { $link f } } }
-{ $contract "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read1
{ $values { "ch/f" "a character or " { $link f } } }
-{ $contract "Reads a character of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a character of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read
{ $values { "n" "a non-negative integer" } { "str/f" "a string or " { $link f } } }
-{ $contract "Reads " { $snippet "n" } " characters of input from the " { $link stdio } " stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $description "Reads " { $snippet "n" } " characters of input from the " { $link stdio } " stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
$io-error ;
HELP: read-until
@@ -192,26 +234,26 @@ $io-error ;
HELP: write
{ $values { "str" string } }
-{ $contract "Writes a string of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a string of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
$io-error ;
HELP: flush
-{ $contract "Waits for any pending output to the " { $link stdio } " stream to complete." }
+{ $description "Waits for any pending output to the " { $link stdio } " stream to complete." }
$io-error ;
HELP: nl
-{ $contract "Writes a line terminator to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a line terminator to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
$io-error ;
HELP: format
{ $values { "str" string } { "style" "a hashtable" } }
-{ $contract "Writes formatted text to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes formatted text to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
{ $notes "Details are in the documentation for " { $link stream-format } "." }
$io-error ;
HELP: with-nesting
{ $values { "style" "a hashtable" } { "quot" "a quotation" } }
-{ $contract "Calls the quotation in a new dynamic scope with the " { $link stdio } " stream rebound to a nested paragraph stream, with formatting information applied." }
+{ $description "Calls the quotation in a new dynamic scope with the " { $link stdio } " stream rebound to a nested paragraph stream, with formatting information applied." }
{ $notes "Details are in the documentation for " { $link make-block-stream } "." }
$io-error ;
diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor
index facfd2b48d..c5c7791a35 100755
--- a/core/system/system-docs.factor
+++ b/core/system/system-docs.factor
@@ -1,5 +1,5 @@
USING: generic help.markup help.syntax kernel math memory
-namespaces sequences kernel.private io.files strings ;
+namespaces sequences kernel.private strings ;
IN: system
ARTICLE: "os" "System interface"
@@ -29,7 +29,7 @@ ARTICLE: "os" "System interface"
{ $subsection millis }
"Exiting the Factor VM:"
{ $subsection exit }
-{ $see-also "io.files" "network-streams" "io.launcher" "io.mmap" } ;
+{ $see-also "io.files" "io.mmap" "io.monitors" "network-streams" "io.launcher" } ;
ABOUT: "os"
diff --git a/extra/calendar/authors.txt b/extra/calendar/authors.txt
index 1901f27a24..7c1b2f2279 100644
--- a/extra/calendar/authors.txt
+++ b/extra/calendar/authors.txt
@@ -1 +1 @@
-Slava Pestov
+Doug Coleman
diff --git a/extra/calendar/format/summary.txt b/extra/calendar/format/summary.txt
new file mode 100644
index 0000000000..b5360f7868
--- /dev/null
+++ b/extra/calendar/format/summary.txt
@@ -0,0 +1 @@
+Formatting dates and times
diff --git a/extra/calendar/model/summary.txt b/extra/calendar/model/summary.txt
new file mode 100644
index 0000000000..4cc85fd2b9
--- /dev/null
+++ b/extra/calendar/model/summary.txt
@@ -0,0 +1 @@
+Timestamp model updated every second
diff --git a/extra/calendar/summary.txt b/extra/calendar/summary.txt
index 4cc85fd2b9..63d1c3fec3 100644
--- a/extra/calendar/summary.txt
+++ b/extra/calendar/summary.txt
@@ -1 +1 @@
-Timestamp model updated every second
+Operations on timestamps and durations
diff --git a/extra/concurrency/flags/flags-docs.factor b/extra/concurrency/flags/flags-docs.factor
index cf37715c5c..11c85240b9 100644
--- a/extra/concurrency/flags/flags-docs.factor
+++ b/extra/concurrency/flags/flags-docs.factor
@@ -21,7 +21,7 @@ HELP: lower-flag
ARTICLE: "concurrency.flags" "Flags"
"A " { $emphasis "flag" } " is a condition notification device which can be in one of two states: " { $emphasis "lowered" } " (the initial state) or " { $emphasis "raised" } "."
$nl
-"The flag can be raised at any time; raising a raised flag does nothing. Lowering a flag if the flag has not been raised, it first waits for it to be raised."
+"The flag can be raised at any time; raising a raised flag does nothing. Lowering a flag if it has not been raised yet will wait for another thread to raise the flag."
$nl
"Essentially, a flag can be thought of as a counting semaphore where the count never goes above one."
{ $subsection flag }
diff --git a/extra/farkup/authors.txt b/extra/farkup/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/extra/farkup/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/farkup/summary.txt b/extra/farkup/summary.txt
new file mode 100644
index 0000000000..c6e75d28a9
--- /dev/null
+++ b/extra/farkup/summary.txt
@@ -0,0 +1 @@
+Simple markup language for generating HTML
diff --git a/extra/farkup/tags.txt b/extra/farkup/tags.txt
new file mode 100644
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/farkup/tags.txt
@@ -0,0 +1 @@
+text
diff --git a/extra/help/cookbook/cookbook.factor b/extra/help/cookbook/cookbook.factor
index 5be69663f8..ebdbdeb37e 100755
--- a/extra/help/cookbook/cookbook.factor
+++ b/extra/help/cookbook/cookbook.factor
@@ -197,7 +197,7 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
{ $code
"\"data.bin\" [ 1024 read ] with-file-reader"
}
-"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory:"
+"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
{ $code
"\"mydata.dat\" dup file-length ["
" 4 <sliced-groups> [ reverse-here ] change-each"
diff --git a/extra/io/launcher/summary.txt b/extra/io/launcher/summary.txt
index 1044a84d4b..c287261b4f 100644
--- a/extra/io/launcher/summary.txt
+++ b/extra/io/launcher/summary.txt
@@ -1 +1 @@
-Support for launching OS processes
+Launching operating system processes
diff --git a/extra/io/server/summary.txt b/extra/io/server/summary.txt
new file mode 100644
index 0000000000..e791b704eb
--- /dev/null
+++ b/extra/io/server/summary.txt
@@ -0,0 +1 @@
+TCP/IP and UDP/IP servers
diff --git a/extra/io/timeouts/summary.txt b/extra/io/timeouts/summary.txt
new file mode 100644
index 0000000000..7a648d30bb
--- /dev/null
+++ b/extra/io/timeouts/summary.txt
@@ -0,0 +1 @@
+Low-level support for setting timeouts on I/O operations
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 41a6cb140f..6afbc33049 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -66,4 +66,4 @@ M: unix-io delete-directory ( path -- )
] with-disposal ;
M: unix-io copy-file ( from to -- )
- over file-permissions >r (copy-file) r> chmod io-error ;
+ >r dup file-permissions over r> (copy-file) chmod io-error ;
diff --git a/extra/regexp/summary.txt b/extra/regexp/summary.txt
new file mode 100644
index 0000000000..aa1e1c27a9
--- /dev/null
+++ b/extra/regexp/summary.txt
@@ -0,0 +1 @@
+Regular expressions
diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor
index f331a687a0..61d7b9eaed 100755
--- a/extra/tools/deploy/macosx/macosx.factor
+++ b/extra/tools/deploy/macosx/macosx.factor
@@ -12,7 +12,7 @@ IN: tools.deploy.macosx
bundle-dir swap path+ swap "Contents" path+ copy-tree ;
: copy-vm ( executable bundle-name -- vm )
- "Contents/MacOS/" path+ swap path+ vm swap copy-file ;
+ "Contents/MacOS/" path+ swap path+ vm over copy-file ;
: copy-fonts ( name -- )
"fonts/" resource-path
diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor
index f78b4d030e..b8a1def3a4 100755
--- a/extra/tools/deploy/windows/windows.factor
+++ b/extra/tools/deploy/windows/windows.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files kernel namespaces sequences system
tools.deploy.backend tools.deploy.config assocs hashtables
@@ -6,19 +6,16 @@ prettyprint windows.shell32 windows.user32 ;
IN: tools.deploy.windows
: copy-vm ( executable bundle-name -- vm )
- swap path+ ".exe" append vm swap [ copy-file ] keep ;
+ swap path+ ".exe" append
+ vm over copy-file ;
: copy-fonts ( bundle-name -- )
"fonts/" resource-path swap copy-tree ;
: copy-dlls ( bundle-name -- )
- {
- "freetype6.dll"
- "zlib1.dll"
- "factor-nt.dll"
- } [
- resource-path swap copy-file-to
- ] with each ;
+ { "freetype6.dll" "zlib1.dll" "factor-nt.dll" }
+ [ resource-path ] map
+ swap copy-files-to ;
: create-exe-dir ( vocab bundle-name -- vm )
dup copy-dlls
diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor
index 745e3b1842..801e5b6d54 100755
--- a/extra/tools/disassembler/disassembler.factor
+++ b/extra/tools/disassembler/disassembler.factor
@@ -5,9 +5,9 @@ io.launcher system assocs arrays sequences namespaces qualified
system math generator.fixup ;
IN: tools.disassembler
-: in-file "gdb-in.txt" resource-path ;
+: in-file "gdb-in.txt" temp-file ;
-: out-file "gdb-out.txt" resource-path ;
+: out-file "gdb-out.txt" temp-file ;
GENERIC: make-disassemble-cmd ( obj -- )
diff --git a/extra/wrap/authors.txt b/extra/wrap/authors.txt
new file mode 100644
index 0000000000..f990dd0ed2
--- /dev/null
+++ b/extra/wrap/authors.txt
@@ -0,0 +1 @@
+Daniel Ehrenberg
diff --git a/extra/wrap/summary.txt b/extra/wrap/summary.txt
new file mode 100644
index 0000000000..1f2d57c99d
--- /dev/null
+++ b/extra/wrap/summary.txt
@@ -0,0 +1 @@
+Word wrapping
diff --git a/extra/wrap/tags.txt b/extra/wrap/tags.txt
new file mode 100644
index 0000000000..8e27be7d61
--- /dev/null
+++ b/extra/wrap/tags.txt
@@ -0,0 +1 @@
+text
From f8df1936a6857c94e2c6853bc18d6d85ba414040 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.internal.stack-effects.com>
Date: Wed, 27 Feb 2008 16:37:20 -0600
Subject: [PATCH 3/3] Fix print-banner
---
core/listener/listener-docs.factor | 3 ---
1 file changed, 3 deletions(-)
diff --git a/core/listener/listener-docs.factor b/core/listener/listener-docs.factor
index 62db4a71a7..ca1027dbc5 100755
--- a/core/listener/listener-docs.factor
+++ b/core/listener/listener-docs.factor
@@ -38,9 +38,6 @@ HELP: listen
{ $description "Prompts for an expression on the " { $link stdio } " stream and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
{ $errors "If the expression input by the user throws an error, the error is printed to the " { $link stdio } " stream and the word returns normally." } ;
-HELP: print-banner
-{ $description "Print Factor version, operating system, and CPU architecture." } ;
-
HELP: listener
{ $description "Prompts for expressions on the " { $link stdio } " stream and evaluates them until end of file is reached." } ;