! Copyright (C) 2017 Alexander Ilin.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.data alien.strings io.encodings.utf16n kernel math
-sequences windows.messages windows.shell32 windows.types ;
+USING: accessors alien alien.data alien.strings continuations
+fry io.encodings.utf16n kernel literals math namespaces
+sequences ui.backend.windows ui.gadgets.worlds ui.gestures
+windows.messages windows.shell32 windows.types windows.user32 ;
IN: windows.dropfiles
: filecount-from-hdrop ( hdrop -- n )
[ swap DragQueryFile drop ] keep
utf16n alien>string
] with map ;
+
+! : point-from-hdrop ( hdrop -- loc )
+! POINT <struct> [ DragQueryPoint drop ] keep [ x>> ] [ y>> ] bi 2array ;
+
+: handle-wm-dropfiles ( hdrop -- )
+ <alien> [ filenames-from-hdrop dropped-files set-global ] [ DragFinish ] bi
+ key-modifiers <file-drop> hand-gadget get-global propagate-gesture ;
+
+! The ChangeWindowMessageFilter has a global per-process effect, and so is the
+! list of wm-handlers. Therefore, there is no benefit in using the stricter
+! ChangeWindowMessageFilterEx approach. Plus, the latter is not in Vista.
+: (init-message-filter) ( -- )
+ ${ WM_DROPFILES WM_COPYDATA WM_COPYGLOBALDATA }
+ [ MSGFLT_ADD ChangeWindowMessageFilter win32-error=0/f ] each ;
+
+: do-once ( guard-variable quot -- )
+ dupd '[ t _ set-global @ ] [ get-global ] dip unless ; inline
+
+SYMBOL: init-message-filter-done?
+
+! Ignore the errors: on WinXP the function is missing, and is not needed.
+: init-message-filter ( -- )
+ init-message-filter-done? [
+ [ (init-message-filter) ] [ drop ] recover
+ ] do-once ;
+
+: install-wm-handler ( -- )
+ [ drop 2nip handle-wm-dropfiles 0 ] WM_DROPFILES add-wm-handler ;
+
+: hwnd-accept-files ( hwnd -- )
+ TRUE DragAcceptFiles init-message-filter install-wm-handler ;
+
+: hwnd-reject-files ( hwnd -- )
+ f DragAcceptFiles ;
+
+: world-accept-files ( world -- )
+ handle>> hWnd>> hwnd-accept-files ;
+
+: world-reject-files ( world -- )
+ handle>> hWnd>> hwnd-accept-files ;
+
+: accept-files ( -- )
+ world get world-accept-files ;
+
+: reject-files ( -- )
+ world get world-reject-files ;