1 USING: alien.strings io.encodings.utf16n windows.com
\r
2 windows.com.wrapper combinators windows.kernel32 windows.ole32
\r
3 windows.shell32 kernel accessors
\r
4 prettyprint namespaces ui.tools.listener ui.tools.workspace
\r
5 alien.c-types alien sequences math ;
\r
6 IN: windows.dragdrop-listener
\r
8 << "WCHAR" require-c-array >>
\r
10 : filenames-from-hdrop ( hdrop -- filenames )
\r
11 dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files
\r
13 2dup f 0 DragQueryFile 1 + ! get size of filename buffer
\r
14 dup "WCHAR" <c-array>
\r
15 [ swap DragQueryFile drop ] keep
\r
19 : filenames-from-data-object ( data-object -- filenames )
\r
20 "FORMATETC" <c-object>
\r
21 CF_HDROP over set-FORMATETC-cfFormat
\r
22 f over set-FORMATETC-ptd
\r
23 DVASPECT_CONTENT over set-FORMATETC-dwAspect
\r
24 -1 over set-FORMATETC-lindex
\r
25 TYMED_HGLOBAL over set-FORMATETC-tymed
\r
26 "STGMEDIUM" <c-object>
\r
27 [ IDataObject::GetData ] keep swap succeeded? [
\r
29 [ filenames-from-hdrop ] with-global-lock
\r
30 swap ReleaseStgMedium
\r
33 TUPLE: listener-dragdrop hWnd last-drop-effect ;
\r
35 : <listener-dragdrop> ( hWnd -- object )
\r
36 DROPEFFECT_NONE listener-dragdrop construct-boa ;
\r
38 SYMBOL: +listener-dragdrop-wrapper+
\r
44 filenames-from-data-object
\r
45 length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if
\r
48 >>last-drop-effect drop
\r
51 [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth
\r
58 filenames-from-data-object
\r
60 first unparse [ "USE: parser " % % " run-file" % ] "" make
\r
63 ] [ 2drop DROPEFFECT_NONE ] if
\r
69 } <com-wrapper> +listener-dragdrop-wrapper+ set-global
\r
71 : dragdrop-listener-window ( -- )
\r
72 get-workspace parent>> handle>> hWnd>>
\r
73 dup <listener-dragdrop>
\r
74 +listener-dragdrop-wrapper+ get-global com-wrap
\r
75 [ RegisterDragDrop ole32-error ] with-com-interface ;
\r