basis/io/monitors/windows/windows.factor

   1 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.data arrays classes.struct
   4 combinators continuations destructors fry io.backend
   5 io.encodings.string io.encodings.utf16n io.files.windows
   6 io.monitors io.pathnames io.ports kernel literals locals make
   7 math sequences system threads windows.errors windows.kernel32
   8 windows.types ;
   9 IN: io.monitors.windows
  10
  11 : open-directory ( path -- handle )
  12     normalize-path
  13     FILE_LIST_DIRECTORY
  14     share-mode
  15     f
  16     OPEN_EXISTING
  17     flags{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED }
  18     f
  19     CreateFile opened-file ;
  20
  21 TUPLE: win32-monitor-port < input-port recursive ;
  22
  23 TUPLE: win32-monitor < monitor port ;
  24
  25 : begin-reading-changes ( port -- overlapped )
  26     {
  27         [ handle>> handle>> ]
  28         [ buffer>> ptr>> ]
  29         [ buffer>> size>> ]
  30         [ recursive>> 1 0 ? ]
  31     } cleave
  32     FILE_NOTIFY_CHANGE_ALL
  33     0 DWORD <ref>
  34     (make-overlapped)
  35     [ f ReadDirectoryChangesW win32-error=0/f ] keep ;
  36
  37 : read-changes ( port -- bytes-transferred )
  38     [
  39         [ begin-reading-changes ] [ twiddle-thumbs ] bi
  40     ] with-destructors ;
  41
  42 : parse-action ( action -- changed )
  43     {
  44         { FILE_ACTION_ADDED [ +add-file+ ] }
  45         { FILE_ACTION_REMOVED [ +remove-file+ ] }
  46         { FILE_ACTION_MODIFIED [ +modify-file+ ] }
  47         { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
  48         { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
  49         [ drop +modify-file+ ]
  50     } case 1array ;
  51
  52 : memory>u16-string ( alien len -- string )
  53     memory>byte-array utf16n decode ;
  54
  55 : parse-notify-record ( buffer -- path changed )
  56     [
  57         [ FileName>> ] [ FileNameLength>> ] bi memory>u16-string
  58     ] [ Action>> parse-action ] bi ;
  59
  60 : (file-notify-records) ( buffer -- buffer )
  61     FILE_NOTIFY_INFORMATION memory>struct
  62     dup ,
  63     dup NextEntryOffset>> zero? [
  64         [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
  65         (file-notify-records)
  66     ] unless ;
  67
  68 : file-notify-records ( buffer -- seq )
  69     [ (file-notify-records) drop ] { } make ;
  70
  71 :: parse-notify-records ( monitor buffer -- )
  72     buffer file-notify-records [
  73         parse-notify-record
  74         [ monitor path>> prepend-path normalize-path ] dip
  75         monitor queue-change
  76     ] each ;
  77
  78 : fill-queue ( monitor -- )
  79     dup port>> check-disposed
  80     [ buffer>> ptr>> ] [ read-changes zero? ] bi
  81     [ 2dup parse-notify-records ] unless
  82     2drop ;
  83
  84 : (fill-queue-thread) ( monitor -- )
  85     dup fill-queue (fill-queue-thread) ;
  86
  87 : fill-queue-thread ( monitor -- )
  88     '[ _ dup fill-queue (fill-queue-thread) ]
  89     [ already-disposed? ] ignore-error ;
  90
  91 M:: windows (monitor) ( path recursive? mailbox -- monitor )
  92     [
  93         path normalize-path mailbox win32-monitor new-monitor
  94             path open-directory \ win32-monitor-port <buffered-port>
  95                 recursive? >>recursive
  96             >>port
  97         dup [ fill-queue-thread ] curry
  98         "Windows monitor thread" spawn drop
  99     ] with-destructors ;
 100
 101 M: win32-monitor dispose
 102     [ port>> dispose ] [ call-next-method ] bi ;