Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
6c3d2775a9
|
|
@ -18,7 +18,7 @@ SYMBOL: begin
|
|||
over push 0 begin ;
|
||||
|
||||
: finish-decoding ( buf ch state -- str )
|
||||
begin eq? [ decode-error ] unless drop { } like ;
|
||||
begin eq? [ decode-error ] unless drop "" like ;
|
||||
|
||||
: decode ( seq quot -- str )
|
||||
>r [ length <sbuf> 0 begin ] keep r> each
|
||||
|
|
|
|||
|
|
@ -8,35 +8,32 @@ $nl
|
|||
"Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ;
|
||||
|
||||
HELP: next-change
|
||||
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } }
|
||||
{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence containing at least one change descriptor; see " { $link "io.monitor.descriptors" } "." } ;
|
||||
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } }
|
||||
{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
|
||||
|
||||
HELP: with-monitor
|
||||
{ $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
|
||||
{ $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ;
|
||||
|
||||
HELP: +change-file+
|
||||
{ $description "Indicates that the contents of the file have changed." } ;
|
||||
HELP: +add-file+
|
||||
{ $description "Indicates that the file has been added to the directory." } ;
|
||||
|
||||
HELP: +change-name+
|
||||
{ $description "Indicates that the file name has changed." } ;
|
||||
HELP: +remove-file+
|
||||
{ $description "Indicates that the file has been removed from the directory." } ;
|
||||
|
||||
HELP: +change-size+
|
||||
{ $description "Indicates that the file size has changed." } ;
|
||||
HELP: +modify-file+
|
||||
{ $description "Indicates that the file contents have changed." } ;
|
||||
|
||||
HELP: +change-attributes+
|
||||
{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ;
|
||||
|
||||
HELP: +change-modified+
|
||||
{ $description "Indicates that the last modification time of the file has changed." } ;
|
||||
HELP: +rename-file+
|
||||
{ $description "Indicates that file has been renamed." } ;
|
||||
|
||||
ARTICLE: "io.monitor.descriptors" "File system change descriptors"
|
||||
"Change descriptors output by " { $link next-change } ":"
|
||||
{ $subsection +change-file+ }
|
||||
{ $subsection +change-name+ }
|
||||
{ $subsection +change-size+ }
|
||||
{ $subsection +change-attributes+ }
|
||||
{ $subsection +change-modified+ } ;
|
||||
{ $subsection +add-file+ }
|
||||
{ $subsection +remove-file+ }
|
||||
{ $subsection +modify-file+ }
|
||||
{ $subsection +rename-file+ }
|
||||
{ $subsection +add-file+ } ;
|
||||
|
||||
ARTICLE: "io.monitor" "File system change monitors"
|
||||
"File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."
|
||||
|
|
|
|||
|
|
@ -7,11 +7,10 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
|||
|
||||
HOOK: next-change io-backend ( monitor -- path changes )
|
||||
|
||||
SYMBOL: +change-file+
|
||||
SYMBOL: +change-name+
|
||||
SYMBOL: +change-size+
|
||||
SYMBOL: +change-attributes+
|
||||
SYMBOL: +change-modified+
|
||||
SYMBOL: +add-file+
|
||||
SYMBOL: +remove-file+
|
||||
SYMBOL: +modify-file+
|
||||
SYMBOL: +rename-file+
|
||||
|
||||
: with-monitor ( path recursive? quot -- )
|
||||
>r <monitor> r> with-disposal ; inline
|
||||
|
|
|
|||
|
|
@ -119,8 +119,15 @@ TUPLE: CreateProcess-args
|
|||
drop STD_ERROR_HANDLE GetStdHandle ;
|
||||
|
||||
: redirect-stderr ( args -- handle )
|
||||
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stderr ?closed ;
|
||||
+stderr+ get
|
||||
dup +stdout+ eq? [
|
||||
drop
|
||||
CreateProcess-args-lpStartupInfo
|
||||
STARTUPINFO-hStdOutput
|
||||
] [
|
||||
GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stderr ?closed
|
||||
] if ;
|
||||
|
||||
: inherited-stdin ( args -- handle )
|
||||
CreateProcess-args-stdin-pipe
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows
|
|||
io.windows.nt.backend kernel math windows windows.kernel32
|
||||
windows.types libc assocs alien namespaces continuations
|
||||
io.monitor io.nonblocking io.buffers io.files io sequences
|
||||
hashtables sorting arrays ;
|
||||
hashtables sorting arrays combinators ;
|
||||
IN: io.windows.nt.monitor
|
||||
|
||||
TUPLE: monitor path recursive? queue closed? ;
|
||||
|
|
@ -53,25 +53,17 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
] with-port-timeout
|
||||
] with-destructors ;
|
||||
|
||||
: parse-action-flag ( action mask symbol -- action )
|
||||
>r over bitand 0 > [ r> , ] [ r> drop ] if ;
|
||||
: parse-action ( action -- changed )
|
||||
{
|
||||
{ [ dup FILE_ACTION_ADDED = ] [ +add-file+ ] }
|
||||
{ [ dup FILE_ACTION_REMOVED = ] [ +remove-file+ ] }
|
||||
{ [ dup FILE_ACTION_MODIFIED = ] [ +modify-file+ ] }
|
||||
{ [ dup FILE_ACTION_RENAMED_OLD_NAME = ] [ +rename-file+ ] }
|
||||
{ [ dup FILE_ACTION_RENAMED_NEW_NAME = ] [ +rename-file+ ] }
|
||||
{ [ t ] [ +modify-file+ ] }
|
||||
} cond nip ;
|
||||
|
||||
: parse-action ( action -- changes )
|
||||
[
|
||||
FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag
|
||||
FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag
|
||||
drop
|
||||
] { } make ;
|
||||
|
||||
: changed-file ( directory buffer -- changes path )
|
||||
: changed-file ( directory buffer -- changed path )
|
||||
{
|
||||
FILE_NOTIFY_INFORMATION-FileName
|
||||
FILE_NOTIFY_INFORMATION-FileNameLength
|
||||
|
|
@ -79,7 +71,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
} get-slots >r memory>u16-string path+ r> parse-action swap ;
|
||||
|
||||
: (changed-files) ( directory buffer -- )
|
||||
2dup changed-file namespace [ append ] change-at
|
||||
2dup changed-file namespace [ swap add ] change-at
|
||||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -83,6 +83,12 @@ IN: windows.kernel32
|
|||
: FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; inline
|
||||
: FILE_NOTIFY_CHANGE_ALL HEX: 3ff ; inline
|
||||
|
||||
: FILE_ACTION_ADDED 1 ; inline
|
||||
: FILE_ACTION_REMOVED 2 ; inline
|
||||
: FILE_ACTION_MODIFIED 3 ; inline
|
||||
: FILE_ACTION_RENAMED_OLD_NAME 4 ; inline
|
||||
: FILE_ACTION_RENAMED_NEW_NAME 5 ; inline
|
||||
|
||||
C-STRUCT: FILE_NOTIFY_INFORMATION
|
||||
{ "DWORD" "NextEntryOffset" }
|
||||
{ "DWORD" "Action" }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,11 @@
|
|||
#include "master.h"
|
||||
|
||||
extern int main();
|
||||
|
||||
const char *vm_executable_path(void)
|
||||
{
|
||||
return NULL;
|
||||
static Dl_info info = {0};
|
||||
if (!info.dli_fname)
|
||||
dladdr(main, &info);
|
||||
return info.dli_fname;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue