1 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
2 ! See https://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.utf16 io.files.windows
6 io.monitors io.pathnames io.ports kernel literals locals make
7 math sequences system threads windows.errors windows.kernel32
9 IN: io.monitors.windows
11 : open-directory ( path -- handle )
17 flags{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED }
19 CreateFile opened-file ;
21 TUPLE: win32-monitor-port < input-port recursive ;
23 TUPLE: win32-monitor < monitor port ;
25 : begin-reading-changes ( port -- overlapped )
32 FILE_NOTIFY_CHANGE_ALL
35 [ f ReadDirectoryChangesW win32-error=0/f ] keep ;
37 : read-changes ( port -- bytes-transferred )
39 [ begin-reading-changes ] [ twiddle-thumbs ] bi
42 : parse-action ( action -- changed )
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+ ]
52 : memory>u16-string ( alien len -- string )
53 memory>byte-array utf16n decode ;
55 : parse-notify-record ( buffer -- path changed )
57 [ FileName>> ] [ FileNameLength>> ] bi memory>u16-string
58 ] [ Action>> parse-action ] bi ;
60 : (file-notify-records) ( buffer -- buffer )
61 FILE_NOTIFY_INFORMATION memory>struct
63 dup NextEntryOffset>> zero? [
64 [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
68 : file-notify-records ( buffer -- seq )
69 [ (file-notify-records) drop ] { } make ;
71 :: parse-notify-records ( monitor buffer -- )
72 buffer file-notify-records [
74 [ monitor path>> prepend-path normalize-path ] dip
78 : fill-queue ( monitor -- )
79 dup port>> check-disposed
80 [ buffer>> ptr>> ] [ read-changes zero? ] bi
81 [ 2dup parse-notify-records ] unless
84 : (fill-queue-thread) ( monitor -- )
85 dup fill-queue (fill-queue-thread) ;
87 : fill-queue-thread ( monitor -- )
88 '[ _ dup fill-queue (fill-queue-thread) ]
89 [ already-disposed? ] ignore-error ;
91 M:: windows (monitor) ( path recursive? mailbox -- monitor )
93 path normalize-path mailbox win32-monitor new-monitor
94 path open-directory \ win32-monitor-port <buffered-port>
95 recursive? >>recursive
97 dup [ fill-queue-thread ] curry
98 "Windows monitor thread" spawn drop
101 M: win32-monitor dispose
102 [ port>> dispose ] [ call-next-method ] bi ;