diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 93cdb56d26..d18babf31b 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -184,8 +184,12 @@ HELP: +unknown+ { $description "A unknown file type." } ; HELP: -{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } } - { "stream" "an input stream" } } +{ + $values + { "path" "a pathname string" } + { "encoding" "an encoding descriptor" } + { "stream" "an input stream" } +} { $description "Outputs an input stream for reading from the specified pathname using the given encoding." } { $errors "Throws an error if the file is unreadable." } ; diff --git a/extra/io/pipes/pipes-tests.factor b/extra/io/pipes/pipes-tests.factor old mode 100644 new mode 100755 index 0b93e4dff2..c1b37f6efc --- a/extra/io/pipes/pipes-tests.factor +++ b/extra/io/pipes/pipes-tests.factor @@ -14,7 +14,7 @@ IN: io.pipes.tests [ { f } ] [ { [ f ] } run-pipeline ] unit-test [ { "Hello" } ] [ "Hello" [ - { [ input-stream [ utf8 ] change readln ] } with-pipeline + { [ input-stream [ utf8 ] change readln ] } run-pipeline ] with-string-reader ] unit-test diff --git a/extra/io/windows/nt/launcher/launcher.factor b/extra/io/windows/nt/launcher/launcher.factor index d74bf8ab95..5a00c27aaf 100755 --- a/extra/io/windows/nt/launcher/launcher.factor +++ b/extra/io/windows/nt/launcher/launcher.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays continuations destructors io -io.windows libc io.nonblocking windows.types +io.windows libc io.nonblocking io.pipes windows.types math windows.kernel32 windows namespaces io.launcher kernel sequences windows.errors assocs splitting system strings io.windows.launcher io.windows.nt.pipes io.backend io.files @@ -19,15 +19,25 @@ IN: io.windows.nt.launcher DuplicateHandle win32-error=0/f ] keep *void* ; +! /dev/null simulation +: null-input ( -- pipe ) + (pipe) [ in>> handle>> ] [ out>> close-handle ] bi ; + +: null-output ( -- pipe ) + (pipe) [ in>> close-handle ] [ out>> handle>> ] bi ; + +: null-pipe ( mode -- pipe ) + { + { GENERIC_READ [ null-input ] } + { GENERIC_WRITE [ null-output ] } + } case ; + ! The below code is based on the example given in ! http://msdn2.microsoft.com/en-us/library/ms682499.aspx : redirect-default ( default obj access-mode create-mode -- handle ) 3drop ; -: redirect-inherit ( default obj access-mode create-mode -- handle ) - 4drop f ; - : redirect-closed ( default obj access-mode create-mode -- handle ) drop 2nip null-pipe ; @@ -44,21 +54,25 @@ IN: io.windows.nt.launcher : set-inherit ( handle ? -- ) >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ; -: redirect-stream ( default stream access-mode create-mode -- handle ) +: redirect-handle ( default handle access-mode create-mode -- handle ) 2drop nip - underlying-handle win32-file-handle - duplicate-handle dup t set-inherit ; + handle>> duplicate-handle dup t set-inherit ; + +: redirect-stream ( default stream access-mode create-mode -- handle ) + >r >r underlying-handle r> r> redirect-handle ; : redirect ( default obj access-mode create-mode -- handle ) { { [ pick not ] [ redirect-default ] } { [ pick +closed+ eq? ] [ redirect-closed ] } { [ pick string? ] [ redirect-file ] } + { [ pick appender? ] [ redirect-file ] } + { [ pick win32-file? ] [ redirect-handle ] } [ redirect-stream ] } cond ; : default-stdout ( args -- handle ) - stdout-pipe>> dup [ pipe-out ] when ; + stdout-pipe>> dup [ out>> ] when ; : redirect-stdout ( process args -- handle ) default-stdout @@ -84,7 +98,7 @@ IN: io.windows.nt.launcher ] if ; : default-stdin ( args -- handle ) - stdin-pipe>> dup [ pipe-in ] when ; + stdin-pipe>> dup [ in>> ] when ; : redirect-stdin ( process args -- handle ) default-stdin @@ -94,46 +108,8 @@ IN: io.windows.nt.launcher redirect STD_INPUT_HANDLE GetStdHandle or ; -: add-pipe-dtors ( pipe -- ) - dup - in>> close-later - out>> close-later ; - -: fill-stdout-pipe ( args -- args ) - - dup add-pipe-dtors - dup pipe-in f set-inherit - >>stdout-pipe ; - -: fill-stdin-pipe ( args -- args ) - - dup add-pipe-dtors - dup pipe-out f set-inherit - >>stdin-pipe ; - M: winnt fill-redirection ( process args -- ) [ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput [ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError [ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput 2drop ; - -M: winnt (process-stream) - [ - current-directory get (normalize-path) cd - - dup make-CreateProcess-args - - fill-stdout-pipe - fill-stdin-pipe - - tuck fill-redirection - - dup call-CreateProcess - - dup stdin-pipe>> pipe-in CloseHandle drop - dup stdout-pipe>> pipe-out CloseHandle drop - - dup lpProcessInformation>> - over stdout-pipe>> in>> f - rot stdin-pipe>> out>> f - ] with-destructors ; diff --git a/extra/io/windows/nt/launcher/test/stderr.factor b/extra/io/windows/nt/launcher/test/stderr.factor index 0b97387cf7..f22f50e406 100755 --- a/extra/io/windows/nt/launcher/test/stderr.factor +++ b/extra/io/windows/nt/launcher/test/stderr.factor @@ -2,4 +2,4 @@ USE: io USE: namespaces "output" write flush -"error" stderr get stream-write stderr get stream-flush +"error" error-stream get stream-write error-stream get stream-flush diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor index 2397d207b9..37784c673c 100755 --- a/extra/io/windows/nt/monitors/monitors.factor +++ b/extra/io/windows/nt/monitors/monitors.factor @@ -3,9 +3,9 @@ USING: alien alien.c-types libc destructors locals kernel math assocs namespaces continuations sequences hashtables sorting arrays combinators math.bitfields strings system -accessors threads -io.backend io.windows io.windows.nt.backend io.monitors -io.nonblocking io.buffers io.files io.timeouts io +accessors threads splitting +io.backend io.windows io.windows.nt.backend io.windows.nt.files +io.monitors io.nonblocking io.buffers io.files io.timeouts io windows windows.kernel32 windows.types ; IN: io.windows.nt.monitors @@ -79,9 +79,12 @@ TUPLE: win32-monitor < monitor port ; : file-notify-records ( buffer -- seq ) [ (file-notify-records) drop ] { } make ; -: parse-notify-records ( monitor buffer -- ) - file-notify-records - [ parse-notify-record rot queue-change ] with each ; +:: parse-notify-records ( monitor buffer -- ) + buffer file-notify-records [ + parse-notify-record + [ monitor path>> prepend-path normalize-path ] dip + monitor queue-change + ] each ; : fill-queue ( monitor -- ) dup port>> check-closed diff --git a/extra/io/windows/nt/pipes/pipes.factor b/extra/io/windows/nt/pipes/pipes.factor index 8ed16bbd65..aa565b52e8 100755 --- a/extra/io/windows/nt/pipes/pipes.factor +++ b/extra/io/windows/nt/pipes/pipes.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays destructors io io.windows libc -windows.types math windows.kernel32 windows namespaces kernel -sequences windows.errors assocs math.parser system random -combinators accessors io.pipes ; +windows.types math.bitfields windows.kernel32 windows namespaces +kernel sequences windows.errors assocs math.parser system random +combinators accessors io.pipes io.nonblocking ; IN: io.windows.nt.pipes ! This code is based on ! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py -: create-named-pipe ( name in-mode -- handle ) - FILE_FLAG_OVERLAPPED bitor +: create-named-pipe ( name -- handle ) + { PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags PIPE_TYPE_BYTE 1 4096 @@ -19,30 +19,20 @@ IN: io.windows.nt.pipes security-attributes-inherit CreateNamedPipe dup win32-error=0/f - dup add-completion ; + dup add-completion + f ; -: open-other-end ( name out-mode -- handle ) - FILE_SHARE_READ FILE_SHARE_WRITE bitor +: open-other-end ( name -- handle ) + GENERIC_WRITE + { FILE_SHARE_READ FILE_SHARE_WRITE } flags security-attributes-inherit OPEN_EXISTING FILE_FLAG_OVERLAPPED f CreateFile dup win32-error=0/f - dup add-completion ; - -: ( name in-mode out-mode -- pipe ) - [ - >r over >r create-named-pipe dup close-later - r> r> open-other-end dup close-later - pipe boa - ] with-destructors ; - -: ( name -- pipe ) - PIPE_ACCESS_INBOUND GENERIC_WRITE ; - -: ( name -- pipe ) - PIPE_ACCESS_OUTBOUND GENERIC_READ ; + dup add-completion + f ; : unique-pipe-name ( -- string ) [ @@ -54,23 +44,10 @@ IN: io.windows.nt.pipes millis # ] "" make ; -: ( -- pipe ) - unique-pipe-name ; - -: ( -- pipe ) - unique-pipe-name ; - -! /dev/null simulation -: null-input ( -- pipe ) - - [ in>> ] [ out>> CloseHandle drop ] bi ; - -: null-output ( -- pipe ) - - [ in>> CloseHandle drop ] [ out>> ] bi ; - -: null-pipe ( mode -- pipe ) - { - { GENERIC_READ [ null-input ] } - { GENERIC_WRITE [ null-output ] } - } case ; +M: winnt (pipe) ( -- pipe ) + [ + unique-pipe-name + [ create-named-pipe dup close-later ] + [ open-other-end dup close-later ] + bi pipe boa + ] with-destructors ; diff --git a/extra/tools/vocabs/monitor/monitor.factor b/extra/tools/vocabs/monitor/monitor.factor index 563cd04e3e..ee5198a8f4 100755 --- a/extra/tools/vocabs/monitor/monitor.factor +++ b/extra/tools/vocabs/monitor/monitor.factor @@ -13,9 +13,9 @@ IN: tools.vocabs.monitor dup ".factor" tail? [ parent-directory ] when ; : chop-vocab-root ( path -- path' ) - "resource:" prepend-path (normalize-path) + "resource:" prepend-path normalize-path dup vocab-roots get - [ (normalize-path) ] map + [ normalize-path ] map [ head? ] with find nip ?head drop ; @@ -29,17 +29,17 @@ IN: tools.vocabs.monitor reset-cache monitor-loop ; -: add-monitor-for-path ( path -- ) - normalize-path dup exists? [ t my-mailbox (monitor) ] when drop ; - +: add-monitor-for-path ( path -- ) + dup exists? [ t my-mailbox (monitor) ] when drop ; + : monitor-thread ( -- ) [ [ vocab-roots get prune [ add-monitor-for-path ] each - + H{ } clone changed-vocabs set-global vocabs [ changed-vocab ] each - + monitor-loop ] with-monitors ] ignore-errors ;