basis/io/monitors/monitors.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io.backend kernel continuations destructors namespaces
   4 sequences assocs hashtables sorting arrays threads boxes
   5 io.timeouts accessors concurrency.mailboxes fry
   6 system vocabs.loader combinators ;
   7 IN: io.monitors
   8
   9 HOOK: init-monitors io-backend ( -- )
  10
  11 M: object init-monitors ;
  12
  13 HOOK: dispose-monitors io-backend ( -- )
  14
  15 M: object dispose-monitors ;
  16
  17 : with-monitors ( quot -- )
  18     [
  19         init-monitors
  20         [ dispose-monitors ] [ ] cleanup
  21     ] with-scope ; inline
  22
  23 TUPLE: monitor < disposable path queue timeout ;
  24
  25 M: monitor timeout timeout>> ;
  26
  27 M: monitor set-timeout timeout<< ;
  28
  29 <PRIVATE
  30
  31 SYMBOL: monitor-disposed
  32
  33 PRIVATE>
  34
  35 M: monitor dispose*
  36     [ monitor-disposed ] dip queue>> mailbox-put ;
  37
  38 : new-monitor ( path mailbox class -- monitor )
  39     new-disposable
  40         swap >>queue
  41         swap >>path ; inline
  42
  43 TUPLE: file-change path changed monitor ;
  44
  45 : queue-change ( path changes monitor -- )
  46     3dup and and [
  47         [ check-disposed ] keep
  48         [ file-change boa ] keep
  49         queue>> mailbox-put
  50     ] [ 3drop ] if ;
  51
  52 HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
  53
  54 : <monitor> ( path recursive? -- monitor )
  55     <mailbox> (monitor) ;
  56
  57 : next-change ( monitor -- change )
  58     [ check-disposed ]
  59     [
  60         [ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout
  61         dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if
  62     ] bi ;
  63
  64 SYMBOL: +add-file+
  65 SYMBOL: +remove-file+
  66 SYMBOL: +modify-file+
  67 SYMBOL: +rename-file-old+
  68 SYMBOL: +rename-file-new+
  69 SYMBOL: +rename-file+
  70
  71 : with-monitor ( path recursive? quot -- )
  72     [ <monitor> ] dip with-disposal ; inline
  73
  74 : run-monitor ( path recursive? quot -- )
  75     '[ [ @ t ] loop ] with-monitor ; inline
  76
  77 {
  78     { [ os macosx? ] [ "io.monitors.macosx" require ] }
  79     { [ os linux? ] [ "io.monitors.linux" require ] }
  80     { [ os windows? ] [ "io.monitors.windows" require ] }
  81     { [ os bsd? ] [ ] }
  82 } cond