1 ! Copyright (C) 2017-2018 Alexander Ilin.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.data alien.libraries alien.strings
4 continuations fry init io.encodings.utf16n kernel literals math
5 namespaces sequences ui.backend.windows ui.gadgets.worlds
6 ui.gestures windows.messages windows.shell32 windows.types
10 : filecount-from-hdrop ( hdrop -- n )
11 0xFFFFFFFF f 0 DragQueryFile ;
13 : filenames-from-hdrop ( hdrop -- filenames )
14 dup filecount-from-hdrop <iota>
16 2dup f 0 DragQueryFile 1 + ! get size of filename buffer
18 [ swap DragQueryFile drop ] keep
22 ! : point-from-hdrop ( hdrop -- loc )
23 ! POINT <struct> [ DragQueryPoint drop ] keep [ x>> ] [ y>> ] bi 2array ;
25 : handle-wm-dropfiles ( hdrop -- )
26 <alien> [ filenames-from-hdrop dropped-files set-global ] [ DragFinish ] bi
27 key-modifiers <file-drop> hand-gadget get-global propagate-gesture ;
29 ! The ChangeWindowMessageFilter has a global per-process effect, and so is the
30 ! list of wm-handlers. Therefore, there is no benefit in using the stricter
31 ! ChangeWindowMessageFilterEx approach. Plus, the latter is not in Vista.
32 : (init-message-filter) ( -- )
33 "ChangeWindowMessageFilter" "user32" dlsym? [
34 ${ WM_DROPFILES WM_COPYDATA WM_COPYGLOBALDATA }
35 [ MSGFLT_ADD ChangeWindowMessageFilter win32-error=0/f ] each
38 : do-once ( guard-variable quot -- )
39 dupd '[ t _ set-global @ ] [ get-global ] dip unless ; inline
41 : init-message-filter ( -- )
42 \ init-message-filter [ (init-message-filter) ] do-once ;
44 : install-wm-handler ( -- )
45 [ drop 2nip handle-wm-dropfiles 0 ] WM_DROPFILES add-wm-handler ;
47 : hwnd-accept-files ( hwnd -- )
48 TRUE DragAcceptFiles init-message-filter install-wm-handler ;
50 : hwnd-reject-files ( hwnd -- )
51 FALSE DragAcceptFiles ;
53 : world-accept-files ( world -- )
54 handle>> hWnd>> hwnd-accept-files ;
56 : world-reject-files ( world -- )
57 handle>> hWnd>> hwnd-reject-files ;
60 world get world-accept-files ;
63 world get world-reject-files ;
66 f \ init-message-filter set-global
67 ] "init-dropfiles" add-startup-hook