basis/io/monitors/monitors.factor

   1 ! Copyright (C) 2008 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
   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 < identity-tuple path queue timeout ;
  24
  25 M: monitor hashcode* path>> hashcode* ;
  26
  27 M: monitor timeout timeout>> ;
  28
  29 M: monitor set-timeout (>>timeout) ;
  30
  31 : new-monitor ( path mailbox class -- monitor )
  32     new
  33         swap >>queue
  34         swap >>path ; inline
  35
  36 : queue-change ( path changes monitor -- )
  37     3dup and and
  38     [ [ 3array ] keep queue>> mailbox-put ] [ 3drop ] if ;
  39
  40 HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
  41
  42 : <monitor> ( path recursive? -- monitor )
  43     <mailbox> (monitor) ;
  44
  45 : next-change ( monitor -- path changed )
  46     [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ;
  47
  48 SYMBOL: +add-file+
  49 SYMBOL: +remove-file+
  50 SYMBOL: +modify-file+
  51 SYMBOL: +rename-file-old+
  52 SYMBOL: +rename-file-new+
  53 SYMBOL: +rename-file+
  54
  55 : with-monitor ( path recursive? quot -- )
  56     [ <monitor> ] dip with-disposal ; inline
  57
  58 {
  59     { [ os macosx? ] [ "io.monitors.macosx" require ] }
  60     { [ os linux? ] [ "io.monitors.linux" require ] }
  61     { [ os winnt? ] [ "io.monitors.windows.nt" require ] }
  62     [ ]
  63 } cond