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 windows.types
\r
4 prettyprint namespaces ui.tools.listener ui.tools.workspace
\r
5 alien.data alien sequences math classes.struct ;
\r
6 SPECIALIZED-ARRAY: WCHAR
\r
7 IN: windows.dragdrop-listener
\r
9 : filenames-from-hdrop ( hdrop -- filenames )
\r
10 dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files
\r
12 2dup f 0 DragQueryFile 1 + ! get size of filename buffer
\r
14 [ swap DragQueryFile drop ] keep
\r
18 : filenames-from-data-object ( data-object -- filenames )
\r
22 DVASPECT_CONTENT >>dwAspect
\r
24 TYMED_HGLOBAL >>tymed
\r
26 [ IDataObject::GetData ] keep swap succeeded? [
\r
28 [ filenames-from-hdrop ] with-global-lock
\r
29 swap ReleaseStgMedium
\r
32 TUPLE: listener-dragdrop hWnd last-drop-effect ;
\r
34 : <listener-dragdrop> ( hWnd -- object )
\r
35 DROPEFFECT_NONE listener-dragdrop construct-boa ;
\r
37 SYMBOL: +listener-dragdrop-wrapper+
\r
43 filenames-from-data-object
\r
44 length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if
\r
47 >>last-drop-effect drop
\r
50 [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth
\r
57 filenames-from-data-object
\r
59 first unparse [ "USE: parser " % % " run-file" % ] "" make
\r
62 ] [ 2drop DROPEFFECT_NONE ] if
\r
68 } <com-wrapper> +listener-dragdrop-wrapper+ set-global
\r
70 : dragdrop-listener-window ( -- )
\r
71 get-workspace parent>> handle>> hWnd>>
\r
72 dup <listener-dragdrop>
\r
73 +listener-dragdrop-wrapper+ get-global com-wrap
\r
74 [ RegisterDragDrop ole32-error ] with-com-interface ;
\r