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