From: Alexander Iljin <ajsoft@yandex.ru>
Date: Mon, 22 Jan 2018 12:18:13 +0000 (+0100)
Subject: dragdrop-listener: resurrected
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor-unmaintained.git;a=commitdiff_plain;h=3f35c1d585ef3f205e32ca5784363ad81c5f4390

dragdrop-listener: resurrected
---

diff --git a/dragdrop-listener/dragdrop-listener.factor b/dragdrop-listener/dragdrop-listener.factor
deleted file mode 100644
index 5f3f12b..0000000
--- a/dragdrop-listener/dragdrop-listener.factor
+++ /dev/null
@@ -1,74 +0,0 @@
-USING: alien.strings io.encodings.utf16n windows.com
-windows.com.wrapper combinators windows.kernel32 windows.ole32
-windows.shell32 kernel accessors windows.types
-prettyprint namespaces ui.tools.listener ui.tools.workspace
-alien.data alien sequences math classes.struct ;
-SPECIALIZED-ARRAY: WCHAR
-IN: windows.dragdrop-listener
-
-: filenames-from-hdrop ( hdrop -- filenames )
-    dup 0xFFFFFFFF f 0 DragQueryFile ! get count of files
-    [
-        2dup f 0 DragQueryFile 1 + ! get size of filename buffer
-        dup WCHAR <c-array>
-        [ swap DragQueryFile drop ] keep
-        utf16n alien>string
-    ] with map ;
-
-: filenames-from-data-object ( data-object -- filenames )
-    FORMATETC <struct>
-        CF_HDROP         >>cfFormat
-        f                >>ptd
-        DVASPECT_CONTENT >>dwAspect
-        -1               >>lindex
-        TYMED_HGLOBAL    >>tymed
-    STGMEDIUM <struct>
-    [ IDataObject::GetData ] keep swap succeeded? [
-        dup data>>
-        [ filenames-from-hdrop ] with-global-lock
-        swap ReleaseStgMedium
-    ] [ drop f ] if ;
-
-TUPLE: listener-dragdrop hWnd last-drop-effect ;
-
-: <listener-dragdrop> ( hWnd -- object )
-    DROPEFFECT_NONE listener-dragdrop construct-boa ;
-
-SYMBOL: +listener-dragdrop-wrapper+
-{
-    { "IDropTarget" {
-        [ ! DragEnter
-            [
-                2drop
-                filenames-from-data-object
-                length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if
-                dup 0
-            ] dip set-ulong-nth
-            >>last-drop-effect drop
-            S_OK
-        ] [ ! DragOver
-            [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth
-            S_OK
-        ] [ ! DragLeave
-            drop S_OK
-        ] [ ! Drop
-            [
-                2drop nip
-                filenames-from-data-object
-                dup length 1 = [
-                    first unparse [ "USE: parser " % % " run-file" % ] "" make
-                    eval-listener
-                    DROPEFFECT_COPY
-                ] [ 2drop DROPEFFECT_NONE ] if
-                0
-            ] dip set-ulong-nth
-            S_OK
-        ]
-    } }
-} <com-wrapper> +listener-dragdrop-wrapper+ set-global
-
-: dragdrop-listener-window ( -- )
-    get-workspace parent>> handle>> hWnd>>
-    dup <listener-dragdrop>
-    +listener-dragdrop-wrapper+ get-global com-wrap
-    [ RegisterDragDrop ole32-error ] with-com-interface ;
diff --git a/dragdrop-listener/platforms.txt b/dragdrop-listener/platforms.txt
deleted file mode 100644
index 8e1a559..0000000
--- a/dragdrop-listener/platforms.txt
+++ /dev/null
@@ -1 +0,0 @@
-windows