1 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings libc destructors locals
4 kernel math assocs namespaces make continuations sequences
5 hashtables sorting arrays combinators math.bitwise strings
6 system accessors threads splitting io.backend io.windows
7 io.windows.nt.backend io.windows.nt.files io.monitors io.ports
8 io.buffers io.files io.timeouts io.encodings.string
9 io.encodings.utf16n io windows windows.kernel32 windows.types ;
10 IN: io.windows.nt.monitors
12 : open-directory ( path -- handle )
18 { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags
20 CreateFile opened-file ;
22 TUPLE: win32-monitor-port < input-port recursive ;
24 TUPLE: win32-monitor < monitor port ;
26 : begin-reading-changes ( port -- overlapped )
33 FILE_NOTIFY_CHANGE_ALL
36 [ f ReadDirectoryChangesW win32-error=0/f ] keep ;
38 : read-changes ( port -- bytes-transferred )
40 [ begin-reading-changes ] [ twiddle-thumbs ] bi
43 : parse-action ( action -- changed )
45 { FILE_ACTION_ADDED [ +add-file+ ] }
46 { FILE_ACTION_REMOVED [ +remove-file+ ] }
47 { FILE_ACTION_MODIFIED [ +modify-file+ ] }
48 { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
49 { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
50 [ drop +modify-file+ ]
53 : memory>u16-string ( alien len -- string )
54 memory>byte-array utf16n decode ;
56 : parse-notify-record ( buffer -- path changed )
58 [ FILE_NOTIFY_INFORMATION-FileName ]
59 [ FILE_NOTIFY_INFORMATION-FileNameLength ]
62 [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
64 : (file-notify-records) ( buffer -- buffer )
66 dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
67 [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
71 : file-notify-records ( buffer -- seq )
72 [ (file-notify-records) drop ] { } make ;
74 :: parse-notify-records ( monitor buffer -- )
75 buffer file-notify-records [
77 [ monitor path>> prepend-path normalize-path ] dip
81 : fill-queue ( monitor -- )
82 dup port>> dup check-disposed
83 [ buffer>> ptr>> ] [ read-changes zero? ] bi
84 [ 2dup parse-notify-records ] unless
87 : (fill-queue-thread) ( monitor -- )
88 dup fill-queue (fill-queue-thread) ;
90 : fill-queue-thread ( monitor -- )
91 [ dup fill-queue (fill-queue-thread) ]
92 [ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ;
94 M:: winnt (monitor) ( path recursive? mailbox -- monitor )
96 path normalize-path mailbox win32-monitor new-monitor
97 path open-directory \ win32-monitor-port <buffered-port>
98 recursive? >>recursive
100 dup [ fill-queue-thread ] curry
101 "Windows monitor thread" spawn drop
104 M: win32-monitor dispose