2010-02-19 06:23:24 -05:00
|
|
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
2008-04-11 23:36:24 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-13 16:00:44 -05:00
|
|
|
USING: accessors concurrency.mailboxes continuations destructors
|
|
|
|
fry io.backend io.timeouts kernel namespaces sequences system
|
|
|
|
vocabs ;
|
2008-04-11 23:36:24 -04:00
|
|
|
IN: io.monitors
|
|
|
|
|
|
|
|
HOOK: init-monitors io-backend ( -- )
|
|
|
|
|
|
|
|
M: object init-monitors ;
|
|
|
|
|
|
|
|
HOOK: dispose-monitors io-backend ( -- )
|
|
|
|
|
|
|
|
M: object dispose-monitors ;
|
|
|
|
|
|
|
|
: with-monitors ( quot -- )
|
|
|
|
[
|
|
|
|
init-monitors
|
2019-04-22 10:49:05 -04:00
|
|
|
[ dispose-monitors ] finally
|
2008-04-11 23:36:24 -04:00
|
|
|
] with-scope ; inline
|
|
|
|
|
2009-08-24 03:26:13 -04:00
|
|
|
TUPLE: monitor < disposable path queue timeout ;
|
2008-04-11 23:36:24 -04:00
|
|
|
|
|
|
|
M: monitor timeout timeout>> ;
|
|
|
|
|
2010-05-05 16:52:54 -04:00
|
|
|
M: monitor set-timeout timeout<< ;
|
2008-04-11 23:36:24 -04:00
|
|
|
|
2010-02-19 06:23:24 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
SYMBOL: monitor-disposed
|
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
|
|
|
M: monitor dispose*
|
|
|
|
[ monitor-disposed ] dip queue>> mailbox-put ;
|
|
|
|
|
2008-04-14 06:07:31 -04:00
|
|
|
: new-monitor ( path mailbox class -- monitor )
|
2009-08-24 03:26:13 -04:00
|
|
|
new-disposable
|
2008-04-11 23:36:24 -04:00
|
|
|
swap >>queue
|
|
|
|
swap >>path ; inline
|
|
|
|
|
2009-01-27 00:18:57 -05:00
|
|
|
TUPLE: file-change path changed monitor ;
|
|
|
|
|
2008-04-11 23:36:24 -04:00
|
|
|
: queue-change ( path changes monitor -- )
|
2010-02-19 06:23:24 -05:00
|
|
|
3dup and and [
|
2014-11-21 11:19:05 -05:00
|
|
|
check-disposed
|
2010-02-19 06:23:24 -05:00
|
|
|
[ file-change boa ] keep
|
|
|
|
queue>> mailbox-put
|
|
|
|
] [ 3drop ] if ;
|
2008-04-11 23:36:24 -04:00
|
|
|
|
|
|
|
HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
|
|
|
|
|
|
|
|
: <monitor> ( path recursive? -- monitor )
|
|
|
|
<mailbox> (monitor) ;
|
|
|
|
|
2009-01-27 00:18:57 -05:00
|
|
|
: next-change ( monitor -- change )
|
2014-11-21 11:19:05 -05:00
|
|
|
check-disposed
|
|
|
|
[ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout
|
|
|
|
dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if ;
|
2008-04-11 23:36:24 -04:00
|
|
|
|
|
|
|
SYMBOL: +add-file+
|
|
|
|
SYMBOL: +remove-file+
|
|
|
|
SYMBOL: +modify-file+
|
|
|
|
SYMBOL: +rename-file-old+
|
|
|
|
SYMBOL: +rename-file-new+
|
|
|
|
SYMBOL: +rename-file+
|
|
|
|
|
|
|
|
: with-monitor ( path recursive? quot -- )
|
2008-12-02 04:10:13 -05:00
|
|
|
[ <monitor> ] dip with-disposal ; inline
|
2008-07-02 22:52:28 -04:00
|
|
|
|
2009-01-27 00:18:57 -05:00
|
|
|
: run-monitor ( path recursive? quot -- )
|
|
|
|
'[ [ @ t ] loop ] with-monitor ; inline
|
|
|
|
|
2014-11-13 16:00:44 -05:00
|
|
|
"io.monitors." os name>> append require
|