io.monitors:next-change now outputs a single value instead of a pathname and a sequence
Slava Pestov
parent
bdc03a5f37
commit
b2a294fac7
|
|
@ -16,7 +16,7 @@ destructors io.timeouts ;
|
|||
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test
|
||||
|
||||
[ t ] [
|
||||
"m" get next-change drop
|
||||
"m" get next-change path>>
|
||||
[ "" = ] [ "monitor-test-self" temp-file = ] bi or
|
||||
] unit-test
|
||||
|
||||
|
|
@ -29,7 +29,7 @@ destructors io.timeouts ;
|
|||
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test
|
||||
|
||||
[ t ] [
|
||||
"m" get next-change drop
|
||||
"m" get next-change path>>
|
||||
[ "" = ] [ "monitor-test-self" temp-file = ] bi or
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -17,9 +17,12 @@ HELP: (monitor)
|
|||
{ $contract "Opens a file system change monitor which listens for changes on " { $snippet "path" } " and posts notifications to " { $snippet "mailbox" } " as triples with shape " { $snippet "{ path changed monitor } " } ". The boolean indicates whether changes in subdirectories should be reported." }
|
||||
{ $errors "Throws an error if the pathname does not exist, if a monitor could not be created or if the platform does not support monitors." } ;
|
||||
|
||||
HELP: file-change
|
||||
{ $class-description "A change notification output by " { $link next-change } ". The " { $snippet "path" } " slot holds a pathname string. The " { $snippet "changed" } " slots holds a sequence of symbols documented in " { $link "io.monitors.descriptors" } "." } ;
|
||||
|
||||
HELP: next-change
|
||||
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changed" "a change descriptor" } }
|
||||
{ $contract "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence of symbols documented in " { $link "io.monitors.descriptors" } "." }
|
||||
{ $values { "monitor" "a monitor" } { "change" file-change } }
|
||||
{ $contract "Waits for file system changes and outputs a change descriptor for the first changed file." }
|
||||
{ $errors "Throws an error if the monitor is closed from another thread." } ;
|
||||
|
||||
HELP: with-monitor
|
||||
|
|
@ -46,7 +49,9 @@ HELP: +rename-file+
|
|||
{ $description "Indicates that a file has been renamed." } ;
|
||||
|
||||
ARTICLE: "io.monitors.descriptors" "File system change descriptors"
|
||||
"Change descriptors output by " { $link next-change } ":"
|
||||
"The " { $link next-change } " word outputs instances of a class:"
|
||||
{ $subsection file-change }
|
||||
"The " { $slot "changed" } " slot holds a sequence which may contain any of the following symbols:"
|
||||
{ $subsection +add-file+ }
|
||||
{ $subsection +remove-file+ }
|
||||
{ $subsection +modify-file+ }
|
||||
|
|
@ -55,7 +60,7 @@ ARTICLE: "io.monitors.descriptors" "File system change descriptors"
|
|||
{ $subsection +rename-file+ } ;
|
||||
|
||||
ARTICLE: "io.monitors.platforms" "Monitors on different platforms"
|
||||
"Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is unspecified, and may even vary on the same platform. User code should not assume either case."
|
||||
"Whether the " { $slot "path" } " slot of a " { $link file-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is unspecified, and may even vary on the same platform. User code should not assume either case."
|
||||
$nl
|
||||
"If the immediate path being monitored was changed, then " { $snippet "path" } " will equal " { $snippet "\"\"" } "; however this condition is not reported on all platforms. See below."
|
||||
{ $heading "Mac OS X" }
|
||||
|
|
@ -63,7 +68,7 @@ $nl
|
|||
$nl
|
||||
{ $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect."
|
||||
$nl
|
||||
"The " { $snippet "changed" } " output value of the " { $link next-change } " word always outputs " { $link +modify-file+ } " and the " { $snippet "path" } " output value is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available."
|
||||
"The " { $snippet "changed" } " slot of the " { $link file-change } " word tuple always contains " { $link +modify-file+ } " and the " { $snippet "path" } " slot is always the directory containing the file that changed. Unlike other platforms, fine-grained information is not available."
|
||||
$nl
|
||||
"Only directories may be monitored, not individual files. Changes to the directory itself (permissions, modification time, and so on) are not reported; only changes to children are reported."
|
||||
{ $heading "Windows" }
|
||||
|
|
@ -107,7 +112,7 @@ $nl
|
|||
{ $code
|
||||
"USE: io.monitors"
|
||||
": watch-loop ( monitor -- )"
|
||||
" dup next-change . . nl nl flush watch-loop ;"
|
||||
" dup next-change . nl nl flush watch-loop ;"
|
||||
""
|
||||
": watch-directory ( path -- )"
|
||||
" [ t [ watch-loop ] with-monitor ] with-monitors"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ USING: io.monitors tools.test io.files system sequences
|
|||
continuations namespaces concurrency.count-downs kernel io
|
||||
threads calendar prettyprint destructors io.timeouts
|
||||
io.files.temp io.directories io.directories.hierarchy
|
||||
io.pathnames ;
|
||||
io.pathnames accessors ;
|
||||
|
||||
os { winnt linux macosx } member? [
|
||||
[
|
||||
|
|
@ -53,7 +53,7 @@ os { winnt linux macosx } member? [
|
|||
"b" get count-down
|
||||
|
||||
[
|
||||
"m" get next-change drop
|
||||
"m" get next-change path>>
|
||||
dup print flush
|
||||
dup parent-directory
|
||||
[ trim-right-separators "xyz" tail? ] either? not
|
||||
|
|
@ -62,7 +62,7 @@ os { winnt linux macosx } member? [
|
|||
"c1" get count-down
|
||||
|
||||
[
|
||||
"m" get next-change drop
|
||||
"m" get next-change path>>
|
||||
dup print flush
|
||||
dup parent-directory
|
||||
[ trim-right-separators "yxy" tail? ] either? not
|
||||
|
|
@ -101,13 +101,13 @@ os { winnt linux macosx } member? [
|
|||
! Non-recursive
|
||||
[ ] [ "monitor-timeout-test" temp-file f <monitor> "m" set ] unit-test
|
||||
[ ] [ 3 seconds "m" get set-timeout ] unit-test
|
||||
[ [ t ] [ "m" get next-change 2drop ] [ ] while ] must-fail
|
||||
[ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
|
||||
[ ] [ "m" get dispose ] unit-test
|
||||
|
||||
! Recursive
|
||||
[ ] [ "monitor-timeout-test" temp-file t <monitor> "m" set ] unit-test
|
||||
[ ] [ 3 seconds "m" get set-timeout ] unit-test
|
||||
[ [ t ] [ "m" get next-change 2drop ] [ ] while ] must-fail
|
||||
[ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
|
||||
[ ] [ "m" get dispose ] unit-test
|
||||
] with-monitors
|
||||
] when
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend kernel continuations destructors namespaces
|
||||
sequences assocs hashtables sorting arrays threads boxes
|
||||
io.timeouts accessors concurrency.mailboxes
|
||||
io.timeouts accessors concurrency.mailboxes fry
|
||||
system vocabs.loader combinators ;
|
||||
IN: io.monitors
|
||||
|
||||
|
|
@ -33,17 +33,19 @@ M: monitor set-timeout (>>timeout) ;
|
|||
swap >>queue
|
||||
swap >>path ; inline
|
||||
|
||||
TUPLE: file-change path changed monitor ;
|
||||
|
||||
: queue-change ( path changes monitor -- )
|
||||
3dup and and
|
||||
[ [ 3array ] keep queue>> mailbox-put ] [ 3drop ] if ;
|
||||
[ [ file-change boa ] keep queue>> mailbox-put ] [ 3drop ] if ;
|
||||
|
||||
HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
|
||||
|
||||
: <monitor> ( path recursive? -- monitor )
|
||||
<mailbox> (monitor) ;
|
||||
|
||||
: next-change ( monitor -- path changed )
|
||||
[ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ;
|
||||
: next-change ( monitor -- change )
|
||||
[ queue>> ] [ timeout ] bi mailbox-get-timeout ;
|
||||
|
||||
SYMBOL: +add-file+
|
||||
SYMBOL: +remove-file+
|
||||
|
|
@ -55,9 +57,15 @@ SYMBOL: +rename-file+
|
|||
: with-monitor ( path recursive? quot -- )
|
||||
[ <monitor> ] dip with-disposal ; inline
|
||||
|
||||
: run-monitor ( path recursive? quot -- )
|
||||
'[ [ @ t ] loop ] with-monitor ; inline
|
||||
|
||||
: spawn-monitor ( path recursive? quot -- )
|
||||
[ '[ _ _ _ run-monitor ] ] [ 2drop "Monitoring " prepend ] 3bi
|
||||
spawn drop ;
|
||||
{
|
||||
{ [ os macosx? ] [ "io.monitors.macosx" require ] }
|
||||
{ [ os linux? ] [ "io.monitors.linux" require ] }
|
||||
{ [ os winnt? ] [ "io.monitors.windows.nt" require ] }
|
||||
[ ]
|
||||
{ [ os bsd? ] [ ] }
|
||||
} cond
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors sequences assocs arrays continuations
|
||||
destructors combinators kernel threads concurrency.messaging
|
||||
|
|
@ -45,12 +45,11 @@ M: recursive-monitor dispose*
|
|||
bi ;
|
||||
|
||||
: stop-pump ( -- )
|
||||
monitor tget children>> [ nip dispose ] assoc-each ;
|
||||
monitor tget children>> values dispose-each ;
|
||||
|
||||
: pump-step ( msg -- )
|
||||
first3 path>> swap [ prepend-path ] dip monitor tget 3array
|
||||
monitor tget queue>>
|
||||
mailbox-put ;
|
||||
[ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
|
||||
monitor tget queue-change ;
|
||||
|
||||
: child-added ( path monitor -- )
|
||||
path>> prepend-path add-child-monitor ;
|
||||
|
|
@ -59,7 +58,7 @@ M: recursive-monitor dispose*
|
|||
path>> prepend-path remove-child-monitor ;
|
||||
|
||||
: update-hierarchy ( msg -- )
|
||||
first3 swap [
|
||||
[ path>> ] [ monitor>> ] [ changed>> ] tri [
|
||||
{
|
||||
{ +add-file+ [ child-added ] }
|
||||
{ +remove-file+ [ child-removed ] }
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: threads io.files io.pathnames io.monitors init kernel
|
||||
vocabs vocabs.loader tools.vocabs namespaces continuations
|
||||
sequences splitting assocs command-line concurrency.messaging
|
||||
io.backend sets tr ;
|
||||
io.backend sets tr accessors ;
|
||||
IN: tools.vocabs.monitor
|
||||
|
||||
TR: convert-separators "/\\" ".." ;
|
||||
|
|
@ -29,7 +29,7 @@ TR: convert-separators "/\\" ".." ;
|
|||
: monitor-loop ( -- )
|
||||
#! On OS X, monitors give us the full path, so we chop it
|
||||
#! off if its there.
|
||||
receive first path>vocab changed-vocab
|
||||
receive path>> path>vocab changed-vocab
|
||||
reset-cache
|
||||
monitor-loop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -354,7 +354,7 @@ IN: google-tech-talk
|
|||
": forever ( quot -- ) '[ @ t ] loop ; inline"
|
||||
""
|
||||
"\"/tmp\" t <monitor>"
|
||||
"'[ _ next-change . . ] forever"
|
||||
"'[ _ next-change . ] forever"
|
||||
}
|
||||
}
|
||||
{ $slide "Example: time server"
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ IN: log-viewer
|
|||
[ print read-lines ] [ 2drop flush ] if ;
|
||||
|
||||
: tail-file-loop ( stream monitor -- )
|
||||
dup next-change 2drop over read-lines tail-file-loop ;
|
||||
dup next-change drop over read-lines tail-file-loop ;
|
||||
|
||||
: tail-file ( file -- )
|
||||
dup utf8 <file-reader> dup read-lines
|
||||
|
|
|
|||
Loading…
Reference in New Issue