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

diff --git a/basis/io/monitors/linux/linux-tests.factor b/basis/io/monitors/linux/linux-tests.factor
index 67558942f80e62c2d1d9111cba877fa6e21805a3..10b3801ea9f20734121ab3e18cb0a02317eb4b48 100644 (file)
--- 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 3242b276e6494de6567902032b91102bfcae600c..f0278e300e03457cc84b5518ec01590decd101b2 100644 (file)
--- 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." }\r
 { $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." } ;\r
 \r
+HELP: file-change\r
+{ $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" } "." } ;\r
+\r
 HELP: next-change\r
-{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changed" "a change descriptor" } }\r
-{ $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" } "." }\r
+{ $values { "monitor" "a monitor" } { "change" file-change } }\r
+{ $contract "Waits for file system changes and outputs a change descriptor for the first changed file." }\r
 { $errors "Throws an error if the monitor is closed from another thread." } ;\r
 \r
 HELP: with-monitor\r
@@ -46,7 +49,9 @@ HELP: +rename-file+
 { $description "Indicates that a file has been renamed." } ;\r
 \r
 ARTICLE: "io.monitors.descriptors" "File system change descriptors"\r
-"Change descriptors output by " { $link next-change } ":"\r
+"The " { $link next-change } " word outputs instances of a class:"\r
+{ $subsection file-change }\r
+"The " { $slot "changed" } " slot holds a sequence which may contain any of the following symbols:"\r
 { $subsection +add-file+ }\r
 { $subsection +remove-file+ }\r
 { $subsection +modify-file+ }\r
@@ -55,7 +60,7 @@ ARTICLE: "io.monitors.descriptors" "File system change descriptors"
 { $subsection +rename-file+ } ;\r
 \r
 ARTICLE: "io.monitors.platforms" "Monitors on different platforms"\r
-"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."\r
+"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."\r
 $nl\r
 "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."\r
 { $heading "Mac OS X" }\r
@@ -63,7 +68,7 @@ $nl
 $nl\r
 { $snippet "FSEventStream" } "s always monitor directory hierarchies recursively, and the " { $snippet "recursive?" } " parameter to " { $link <monitor> } " has no effect."\r
 $nl\r
-"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."\r
+"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."\r
 $nl\r
 "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."\r
 { $heading "Windows" }\r
@@ -107,7 +112,7 @@ $nl
 { $code\r
     "USE: io.monitors"\r
     ": watch-loop ( monitor -- )"\r
-    "    dup next-change . . nl nl flush watch-loop ;"\r
+    "    dup next-change . nl nl flush watch-loop ;"\r
     ""\r
     ": watch-directory ( path -- )"\r
     "    [ t [ watch-loop ] with-monitor ] with-monitors"\r

diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor
index 9efa785061a1c629f74fe773017135abc96ec747..7c50a4e63782c11915baeedc25920ecdec68fbfa 100644 (file)
--- 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 <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

diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor
index e225e45430b51afc6fceaa7801b455575ee85e91..7d40a1563a6020f9d42bf1f83a8b028488c113fa 100644 (file)
--- 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 )
 
 : <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

diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor
index 18fa62f6d69bad878a5eca23a761d1d125331c7e..943345bf1831e1ff5edc134c7413b1fe589e4f35 100644 (file)
--- 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 ac0160e58f1477e166f788a9ab9d4d6d52bd9549..4091cdd90cd0275e210cde4346fef013bd5b70c8 100644 (file)
--- a/basis/tools/vocabs/monitor/monitor.factor
+++ b/basis/tools/vocabs/monitor/monitor.factor
@@ -1,9 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.\r
+! Copyright (C) 2008, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: threads io.files io.pathnames io.monitors init kernel\r
 vocabs vocabs.loader tools.vocabs namespaces continuations\r
 sequences splitting assocs command-line concurrency.messaging\r
-io.backend sets tr ;\r
+io.backend sets tr accessors ;\r
 IN: tools.vocabs.monitor\r
 \r
 TR: convert-separators "/\\" ".." ;\r
@@ -29,7 +29,7 @@ TR: convert-separators "/\\" ".." ;
 : monitor-loop ( -- )\r
     #! On OS X, monitors give us the full path, so we chop it\r
     #! off if its there.\r
-    receive first path>vocab changed-vocab\r
+    receive path>> path>vocab changed-vocab\r
     reset-cache\r
     monitor-loop ;\r
 \r

diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor
index 84c0134b82194f9e532ffe468ba42e38dce39365..9bd3c5854b536a44ebbf4db7d69ad2238026da7d 100644 (file)
--- 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 <monitor>"
-            "'[ _ 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 263454f7692e132ad57205976240068a3685299a..08a5eac72d8b2469ce54a957bbbe9d8cc08c8940 100755 (executable)
--- 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 ;\r
 \r
 : tail-file-loop ( stream monitor -- )\r
-    dup next-change 2drop over read-lines tail-file-loop ;\r
+    dup next-change drop over read-lines tail-file-loop ;\r
 \r
 : tail-file ( file -- )\r
     dup utf8 <file-reader> dup read-lines\r