summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlexander Iljin <ajsoft@yandex.ru>2018-01-22 13:18:13 +0100
committerAlexander Iljin <ajsoft@yandex.ru>2018-01-22 13:18:13 +0100
commit3f35c1d585ef3f205e32ca5784363ad81c5f4390 (patch)
tree80ad0a48aa743240f1272f53c29490e0ddc2f9e2
parentf44fc09729386b7f3ee16b7af1b69bdd14ace1d3 (diff)
dragdrop-listener: resurrected
-rw-r--r--dragdrop-listener/dragdrop-listener.factor74
-rw-r--r--dragdrop-listener/platforms.txt1
2 files changed, 0 insertions, 75 deletions
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