1(*
2    Copyright (c) 2001, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18structure DragDrop:
19  sig
20    type HDROP
21    type HWND (* = Window.HWND *)
22    type POINT = { x: int, y: int }
23    val DragAcceptFiles : HWND * bool -> unit
24    val DragFinish : HDROP -> unit
25    val DragQueryFile : HDROP -> string list
26    val DragQueryPoint : HDROP -> POINT * bool
27  end =
28struct
29    local
30        open Foreign Base
31    in
32        type HDROP = HDROP and HWND = HWND
33        type POINT = POINT
34
35        (* Call DragAcceptFiles to accept files. *)
36        val DragAcceptFiles = winCall2 (shell "DragAcceptFiles") (cHWND,cBool) cVoid
37
38        (* Call DragFinish when finished processing a WM_DROP message. *)
39        and DragFinish = winCall1 (shell "DragFinish") (cHDROP) cVoid
40
41        (* Call DragQueryFile to get the file(s). *)
42        local
43            val dragQueryFile = winCall4 (shell "DragQueryFileA") (cHDROP,cUint,cPointer,cUint) cUint
44        in
45            fun DragQueryFile (hd: HDROP): string list =
46            let
47                val nfiles = dragQueryFile(hd, ~1, Memory.null, 0)
48                fun getFile n =
49                let
50                    val buffsize =
51                        dragQueryFile(hd, n, Memory.null, 0) + 1 (* Must add one for NULL *)
52                    open Memory
53                    val buff = malloc(Word.fromInt buffsize)
54                    val _ =
55                        dragQueryFile(hd, n, buff, buffsize)
56                            handle ex => (free buff; raise ex)
57                in
58                    fromCstring buff before free buff
59                end
60            in
61                List.tabulate(nfiles, getFile)
62            end
63        end
64
65        (* Call DragQueryPoint to find out where to drop the file(s). *)
66        local
67            val dragQueryPoint = winCall2 (shell "DragQueryPoint") (cHDROP, cStar cPoint) cBool
68        in
69            fun DragQueryPoint (hd: HDROP): POINT * bool =
70            let
71                val r = ref {x=0, y=0}
72                val res = dragQueryPoint(hd, r)
73            in
74                (!r, res)
75            end
76        end
77    end
78end;
79