]> gitweb.factorcode.org Git - factor.git/blobdiff - unmaintained/dragdrop-listener/dragdrop-listener.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / unmaintained / dragdrop-listener / dragdrop-listener.factor
index 650c9bef243577e378b19665d76d410f501db785..5f3f12b22773c8f0895462916175cfc123a2afcc 100644 (file)
@@ -1,74 +1,74 @@
-USING: alien.strings io.encodings.utf16n windows.com\r
-windows.com.wrapper combinators windows.kernel32 windows.ole32\r
-windows.shell32 kernel accessors windows.types\r
-prettyprint namespaces ui.tools.listener ui.tools.workspace\r
-alien.data alien sequences math classes.struct ;\r
-SPECIALIZED-ARRAY: WCHAR\r
-IN: windows.dragdrop-listener\r
-\r
-: filenames-from-hdrop ( hdrop -- filenames )\r
-    dup 0xFFFFFFFF f 0 DragQueryFile ! get count of files\r
-    [\r
-        2dup f 0 DragQueryFile 1 + ! get size of filename buffer\r
-        dup WCHAR <c-array>\r
-        [ swap DragQueryFile drop ] keep\r
-        utf16n alien>string\r
-    ] with map ;\r
-\r
-: filenames-from-data-object ( data-object -- filenames )\r
-    FORMATETC <struct>\r
-        CF_HDROP         >>cfFormat\r
-        f                >>ptd\r
-        DVASPECT_CONTENT >>dwAspect\r
-        -1               >>lindex\r
-        TYMED_HGLOBAL    >>tymed\r
-    STGMEDIUM <struct>\r
-    [ IDataObject::GetData ] keep swap succeeded? [\r
-        dup data>>\r
-        [ filenames-from-hdrop ] with-global-lock\r
-        swap ReleaseStgMedium\r
-    ] [ drop f ] if ;\r
-\r
-TUPLE: listener-dragdrop hWnd last-drop-effect ;\r
-\r
-: <listener-dragdrop> ( hWnd -- object )\r
-    DROPEFFECT_NONE listener-dragdrop construct-boa ;\r
-\r
-SYMBOL: +listener-dragdrop-wrapper+\r
-{\r
-    { "IDropTarget" {\r
-        [ ! DragEnter\r
-            [\r
-                2drop\r
-                filenames-from-data-object\r
-                length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if\r
-                dup 0\r
-            ] dip set-ulong-nth\r
-            >>last-drop-effect drop\r
-            S_OK\r
-        ] [ ! DragOver\r
-            [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth\r
-            S_OK\r
-        ] [ ! DragLeave\r
-            drop S_OK\r
-        ] [ ! Drop\r
-            [\r
-                2drop nip\r
-                filenames-from-data-object\r
-                dup length 1 = [\r
-                    first unparse [ "USE: parser " % % " run-file" % ] "" make\r
-                    eval-listener\r
-                    DROPEFFECT_COPY\r
-                ] [ 2drop DROPEFFECT_NONE ] if\r
-                0\r
-            ] dip set-ulong-nth\r
-            S_OK\r
-        ]\r
-    } }\r
-} <com-wrapper> +listener-dragdrop-wrapper+ set-global\r
-\r
-: dragdrop-listener-window ( -- )\r
-    get-workspace parent>> handle>> hWnd>>\r
-    dup <listener-dragdrop>\r
-    +listener-dragdrop-wrapper+ get-global com-wrap\r
-    [ RegisterDragDrop ole32-error ] with-com-interface ;\r
+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 ;