steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.monitors:next-change now outputs a single value instead of a pathname and a sequence

db4
Slava Pestov 2009-01-26 23:18:57 -06:00
parent bdc03a5f37
commit b2a294fac7
8 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/io/monitors/linux/linux-tests.factor
View File

@ -16,7 +16,7 @@ destructors io.timeouts ;
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test [ ] [ "monitor-test-self" temp-file touch-file ] unit-test
[ t ] [ [ t ] [
"m" get next-change drop "m" get next-change path>>
[ "" = ] [ "monitor-test-self" temp-file = ] bi or [ "" = ] [ "monitor-test-self" temp-file = ] bi or
] unit-test ] unit-test
@ -29,7 +29,7 @@ destructors io.timeouts ;
[ ] [ "monitor-test-self" temp-file touch-file ] unit-test [ ] [ "monitor-test-self" temp-file touch-file ] unit-test
[ t ] [ [ t ] [
"m" get next-change drop "m" get next-change path>>
[ "" = ] [ "monitor-test-self" temp-file = ] bi or [ "" = ] [ "monitor-test-self" temp-file = ] bi or
] unit-test ] unit-test

17
basis/io/monitors/monitors-docs.factor
View File

@ -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." } { $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." } ; { $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 HELP: next-change
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changed" "a change descriptor" } } { $values { "monitor" "a monitor" } { "change" file-change } }
{ $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" } "." } { $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." } ; { $errors "Throws an error if the monitor is closed from another thread." } ;
HELP: with-monitor HELP: with-monitor
@ -46,7 +49,9 @@ HELP: +rename-file+
{ $description "Indicates that a file has been renamed." } ; { $description "Indicates that a file has been renamed." } ;
ARTICLE: "io.monitors.descriptors" "File system change descriptors" 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 +add-file+ }
{ $subsection +remove-file+ } { $subsection +remove-file+ }
{ $subsection +modify-file+ } { $subsection +modify-file+ }
@ -55,7 +60,7 @@ ARTICLE: "io.monitors.descriptors" "File system change descriptors"
{ $subsection +rename-file+ } ; { $subsection +rename-file+ } ;
ARTICLE: "io.monitors.platforms" "Monitors on different platforms" 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 $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." "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" } { $heading "Mac OS X" }
@ -63,7 +68,7 @@ $nl
$nl $nl
{ $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect." { $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect."
$nl $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 $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." "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" } { $heading "Windows" }
@ -107,7 +112,7 @@ $nl
{ $code { $code
"USE: io.monitors" "USE: io.monitors"
": watch-loop ( monitor -- )" ": watch-loop ( monitor -- )"
" dup next-change . . nl nl flush watch-loop ;" " dup next-change . nl nl flush watch-loop ;"
"" ""
": watch-directory ( path -- )" ": watch-directory ( path -- )"
" [ t [ watch-loop ] with-monitor ] with-monitors" " [ t [ watch-loop ] with-monitor ] with-monitors"

10
basis/io/monitors/monitors-tests.factor
View File

@ -3,7 +3,7 @@ USING: io.monitors tools.test io.files system sequences
continuations namespaces concurrency.count-downs kernel io continuations namespaces concurrency.count-downs kernel io
threads calendar prettyprint destructors io.timeouts threads calendar prettyprint destructors io.timeouts
io.files.temp io.directories io.directories.hierarchy io.files.temp io.directories io.directories.hierarchy
io.pathnames ; io.pathnames accessors ;
os { winnt linux macosx } member? [ os { winnt linux macosx } member? [
[ [
@ -53,7 +53,7 @@ os { winnt linux macosx } member? [
"b" get count-down "b" get count-down
[ [
"m" get next-change drop "m" get next-change path>>
dup print flush dup print flush
dup parent-directory dup parent-directory
[ trim-right-separators "xyz" tail? ] either? not [ trim-right-separators "xyz" tail? ] either? not
@ -62,7 +62,7 @@ os { winnt linux macosx } member? [
"c1" get count-down "c1" get count-down
[ [
"m" get next-change drop "m" get next-change path>>
dup print flush dup print flush
dup parent-directory dup parent-directory
[ trim-right-separators "yxy" tail? ] either? not [ trim-right-separators "yxy" tail? ] either? not
@ -101,13 +101,13 @@ os { winnt linux macosx } member? [
! Non-recursive ! Non-recursive
[ ] [ "monitor-timeout-test" temp-file f <monitor> "m" set ] unit-test [ ] [ "monitor-timeout-test" temp-file f <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] 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 [ ] [ "m" get dispose ] unit-test
! Recursive ! Recursive
[ ] [ "monitor-timeout-test" temp-file t <monitor> "m" set ] unit-test [ ] [ "monitor-timeout-test" temp-file t <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] 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 [ ] [ "m" get dispose ] unit-test
] with-monitors ] with-monitors
] when ] when

20
basis/io/monitors/monitors.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.backend kernel continuations destructors namespaces USING: io.backend kernel continuations destructors namespaces
sequences assocs hashtables sorting arrays threads boxes sequences assocs hashtables sorting arrays threads boxes
io.timeouts accessors concurrency.mailboxes io.timeouts accessors concurrency.mailboxes fry
system vocabs.loader combinators ; system vocabs.loader combinators ;
IN: io.monitors IN: io.monitors
@ -33,17 +33,19 @@ M: monitor set-timeout (>>timeout) ;
swap >>queue swap >>queue
swap >>path ; inline swap >>path ; inline
TUPLE: file-change path changed monitor ;
: queue-change ( path changes monitor -- ) : queue-change ( path changes monitor -- )
3dup and and 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 ) HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
: <monitor> ( path recursive? -- monitor ) : <monitor> ( path recursive? -- monitor )
<mailbox> (monitor) ; <mailbox> (monitor) ;
: next-change ( monitor -- path changed ) : next-change ( monitor -- change )
[ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; [ queue>> ] [ timeout ] bi mailbox-get-timeout ;
SYMBOL: +add-file+ SYMBOL: +add-file+
SYMBOL: +remove-file+ SYMBOL: +remove-file+
@ -55,9 +57,15 @@ SYMBOL: +rename-file+
: with-monitor ( path recursive? quot -- ) : with-monitor ( path recursive? quot -- )
[ <monitor> ] dip with-disposal ; inline [ <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 macosx? ] [ "io.monitors.macosx" require ] }
{ [ os linux? ] [ "io.monitors.linux" require ] } { [ os linux? ] [ "io.monitors.linux" require ] }
{ [ os winnt? ] [ "io.monitors.windows.nt" require ] } { [ os winnt? ] [ "io.monitors.windows.nt" require ] }
[ ] { [ os bsd? ] [ ] }
} cond } cond

11
basis/io/monitors/recursive/recursive.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors sequences assocs arrays continuations USING: accessors sequences assocs arrays continuations
destructors combinators kernel threads concurrency.messaging destructors combinators kernel threads concurrency.messaging
@ -45,12 +45,11 @@ M: recursive-monitor dispose*
bi ; bi ;
: stop-pump ( -- ) : stop-pump ( -- )
monitor tget children>> [ nip dispose ] assoc-each ; monitor tget children>> values dispose-each ;
: pump-step ( msg -- ) : pump-step ( msg -- )
first3 path>> swap [ prepend-path ] dip monitor tget 3array [ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
monitor tget queue>> monitor tget queue-change ;
mailbox-put ;
: child-added ( path monitor -- ) : child-added ( path monitor -- )
path>> prepend-path add-child-monitor ; path>> prepend-path add-child-monitor ;
@ -59,7 +58,7 @@ M: recursive-monitor dispose*
path>> prepend-path remove-child-monitor ; path>> prepend-path remove-child-monitor ;
: update-hierarchy ( msg -- ) : update-hierarchy ( msg -- )
first3 swap [ [ path>> ] [ monitor>> ] [ changed>> ] tri [
{ {
{ +add-file+ [ child-added ] } { +add-file+ [ child-added ] }
{ +remove-file+ [ child-removed ] } { +remove-file+ [ child-removed ] }

6
basis/tools/vocabs/monitor/monitor.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: threads io.files io.pathnames io.monitors init kernel USING: threads io.files io.pathnames io.monitors init kernel
vocabs vocabs.loader tools.vocabs namespaces continuations vocabs vocabs.loader tools.vocabs namespaces continuations
sequences splitting assocs command-line concurrency.messaging sequences splitting assocs command-line concurrency.messaging
io.backend sets tr ; io.backend sets tr accessors ;
IN: tools.vocabs.monitor IN: tools.vocabs.monitor
TR: convert-separators "/\\" ".." ; TR: convert-separators "/\\" ".." ;
@ -29,7 +29,7 @@ TR: convert-separators "/\\" ".." ;
: monitor-loop ( -- ) : monitor-loop ( -- )
#! On OS X, monitors give us the full path, so we chop it #! On OS X, monitors give us the full path, so we chop it
#! off if its there. #! off if its there.
receive first path>vocab changed-vocab receive path>> path>vocab changed-vocab
reset-cache reset-cache
monitor-loop ; monitor-loop ;

2
extra/google-tech-talk/google-tech-talk.factor
View File

@ -354,7 +354,7 @@ IN: google-tech-talk
": forever ( quot -- ) '[ @ t ] loop ; inline" ": forever ( quot -- ) '[ @ t ] loop ; inline"
"" ""
"\"/tmp\" t <monitor>" "\"/tmp\" t <monitor>"
"'[ _ next-change . . ] forever" "'[ _ next-change . ] forever"
} }
} }
{ $slide "Example: time server" { $slide "Example: time server"

2
extra/log-viewer/log-viewer.factor
View File

@ -6,7 +6,7 @@ IN: log-viewer
[ print read-lines ] [ 2drop flush ] if ; [ print read-lines ] [ 2drop flush ] if ;
: tail-file-loop ( stream monitor -- ) : 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 -- ) : tail-file ( file -- )
dup utf8 <file-reader> dup read-lines dup utf8 <file-reader> dup read-lines