diff --git a/basis/io/monitors/linux/linux-tests.factor b/basis/io/monitors/linux/linux-tests.factor index 67558942f8..10b3801ea9 100644 --- a/basis/io/monitors/linux/linux-tests.factor +++ b/basis/io/monitors/linux/linux-tests.factor @@ -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 diff --git a/basis/io/monitors/monitors-docs.factor b/basis/io/monitors/monitors-docs.factor index 3242b276e6..f0278e300e 100644 --- a/basis/io/monitors/monitors-docs.factor +++ b/basis/io/monitors/monitors-docs.factor @@ -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 } " 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 } " 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 } " 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" diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor index 9efa785061..7c50a4e637 100644 --- a/basis/io/monitors/monitors-tests.factor +++ b/basis/io/monitors/monitors-tests.factor @@ -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 "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 "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 diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index e225e45430..7d40a1563a 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -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 ) : ( path recursive? -- monitor ) (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 -- ) [ ] 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 diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index 18fa62f6d6..943345bf18 100644 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -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 ] } diff --git a/basis/tools/vocabs/monitor/monitor.factor b/basis/tools/vocabs/monitor/monitor.factor index ac0160e58f..4091cdd90c 100644 --- a/basis/tools/vocabs/monitor/monitor.factor +++ b/basis/tools/vocabs/monitor/monitor.factor @@ -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 ; diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 84c0134b82..9bd3c5854b 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/extra/google-tech-talk/google-tech-talk.factor @@ -354,7 +354,7 @@ IN: google-tech-talk ": forever ( quot -- ) '[ @ t ] loop ; inline" "" "\"/tmp\" t " - "'[ _ next-change . . ] forever" + "'[ _ next-change . ] forever" } } { $slide "Example: time server" diff --git a/extra/log-viewer/log-viewer.factor b/extra/log-viewer/log-viewer.factor index 263454f769..08a5eac72d 100755 --- a/extra/log-viewer/log-viewer.factor +++ b/extra/log-viewer/log-viewer.factor @@ -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 dup read-lines