-! Copyright (C) 2017 Alexander Ilin.
+! Copyright (C) 2017-2018 Alexander Ilin.
! See http://factorcode.org/license.txt for BSD license.
-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 ;
+USING: accessors alien alien.data alien.libraries alien.strings
+init io.encodings.utf16n kernel literals math namespaces
+sequences ui.backend.windows ui.gadgets.worlds
+ui.gestures windows.errors windows.messages windows.shell32
+windows.types windows.user32 ;
IN: windows.dropfiles
: filecount-from-hdrop ( hdrop -- n )
] with map ;
! : point-from-hdrop ( hdrop -- loc )
-! POINT <struct> [ DragQueryPoint drop ] keep [ x>> ] [ y>> ] bi 2array ;
+! POINT new [ DragQueryPoint drop ] keep [ x>> ] [ y>> ] bi 2array ;
: handle-wm-dropfiles ( hdrop -- )
<alien> [ filenames-from-hdrop dropped-files set-global ] [ DragFinish ] bi
! 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 ;
+ "ChangeWindowMessageFilter" "user32" dlsym? [
+ ${ WM_DROPFILES WM_COPYDATA WM_COPYGLOBALDATA }
+ [ MSGFLT_ADD ChangeWindowMessageFilter win32-error=0/f ] each
+ ] when ;
: 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 ;
+ \ init-message-filter [ (init-message-filter) ] do-once ;
: install-wm-handler ( -- )
[ drop 2nip handle-wm-dropfiles 0 ] WM_DROPFILES add-wm-handler ;
TRUE DragAcceptFiles init-message-filter install-wm-handler ;
: hwnd-reject-files ( hwnd -- )
- f DragAcceptFiles ;
+ FALSE DragAcceptFiles ;
: world-accept-files ( world -- )
handle>> hWnd>> hwnd-accept-files ;
: world-reject-files ( world -- )
- handle>> hWnd>> hwnd-accept-files ;
+ handle>> hWnd>> hwnd-reject-files ;
: accept-files ( -- )
world get world-accept-files ;
: reject-files ( -- )
world get world-reject-files ;
+
+[
+ f \ init-message-filter set-global
+] "init-dropfiles" add-startup-hook