basis/vocabs/refresh/monitor/monitor.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors command-line continuations fry init io
   4 io.backend io.files io.monitors io.pathnames kernel namespaces
   5 prettyprint sequences splitting threads tr vocabs vocabs.cache
   6 vocabs.loader vocabs.refresh ;
   7 IN: vocabs.refresh.monitor
   8
   9 TR: convert-separators "/\\" ".." ;
  10
  11 : vocab-dir>vocab-name ( path -- vocab )
  12     trim-head-separators
  13     trim-tail-separators
  14     convert-separators ;
  15
  16 : path>vocab-name ( path -- vocab )
  17     dup ".factor" tail? [ parent-directory ] when ;
  18
  19 : chop-vocab-root ( path -- path' )
  20     "resource:" prepend-path normalize-path
  21     dup vocab-roots get
  22     [ [ normalize-path ] map ]
  23     [ [ resolve-symlinks ] map ] bi append
  24     [ head? ] with find nip
  25     ?head drop ;
  26
  27 : path>vocab ( path -- vocab )
  28     chop-vocab-root path>vocab-name vocab-dir>vocab-name ;
  29
  30 : monitor-loop ( monitor -- )
  31     ! On OS X, monitors give us the full path, so we chop it
  32     ! off if its there.
  33     [
  34         next-change path>>
  35         [
  36             path>vocab
  37             [ changed-vocab ] [ reset-cache ] bi
  38         ] [
  39             [
  40                 [ "monitor-loop warning for path ``" "``:" surround write ]
  41                 [ . ] bi* flush
  42             ] with-global
  43         ] recover
  44     ] [ monitor-loop ] bi ;
  45
  46 : (start-vocab-monitor) ( vocab-root -- )
  47     dup file-exists?
  48     [ [ t <monitor> monitor-loop ] with-monitors ] [ drop ] if ;
  49
  50 : start-vocab-monitor ( vocab-root -- )
  51     [
  52         dup '[
  53             [ _ (start-vocab-monitor) ]
  54             [
  55                 [
  56                     _ "fatal error for monitor root ``" "``: " surround write
  57                     . flush
  58                 ] with-global
  59             ] recover
  60         ]
  61     ] [ "Root monitor: " prepend ]
  62     bi spawn drop ;
  63
  64 : init-vocab-monitor ( -- )
  65     HS{ } clone changed-vocabs set-global
  66     loaded-vocab-names [ changed-vocab ] each ;
  67
  68 [
  69     "-no-monitors" (command-line) member? [
  70         [ drop ] add-vocab-root-hook set-global
  71         f changed-vocabs set-global
  72     ] [
  73         init-vocab-monitor
  74         vocab-roots get [ start-vocab-monitor ] each
  75         [ start-vocab-monitor ] add-vocab-root-hook set-global
  76     ] if
  77 ] "vocabs.refresh.monitor" add-startup-hook