basis/io/monitors/monitors.factor

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