--- /dev/null
+(* this is a translation in Caml of the gtk+ example testdnd.c *)
+
+
+open Gaux
+open Gtk
+open GObj
+open GMain
+
+(* GtkThread.start() *)
+
+let drag_icon_xpm = [|
+"36 48 9 1";
+" c None";
+". c #020204";
+"+ c #8F8F90";
+"@ c #D3D3D2";
+"# c #AEAEAC";
+"$ c #ECECEC";
+"% c #A2A2A4";
+"& c #FEFEFC";
+"* c #BEBEBC";
+" .....................";
+" ..&&&&&&&&&&&&&&&&&&&.";
+" ...&&&&&&&&&&&&&&&&&&&.";
+" ..&.&&&&&&&&&&&&&&&&&&&.";
+" ..&&.&&&&&&&&&&&&&&&&&&&.";
+" ..&&&.&&&&&&&&&&&&&&&&&&&.";
+" ..&&&&.&&&&&&&&&&&&&&&&&&&.";
+" ..&&&&&.&&&@&&&&&&&&&&&&&&&.";
+" ..&&&&&&.*$%$+$&&&&&&&&&&&&&.";
+" ..&&&&&&&.%$%$+&&&&&&&&&&&&&&.";
+" ..&&&&&&&&.#&#@$&&&&&&&&&&&&&&.";
+" ..&&&&&&&&&.#$**#$&&&&&&&&&&&&&.";
+" ..&&&&&&&&&&.&@%&%$&&&&&&&&&&&&&.";
+" ..&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&.";
+" ..&&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&.";
+"................&$@&&&@&&&&&&&&&&&&.";
+".&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&&&&&.";
+".&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&&&.";
+".&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&&&.";
+".&&&&&&@#@@$&*@&@#@#$**#$&&&&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&@%&%$&&&&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&&+&$+&$&@&$@&&$@&&&&&&&&&&.";
+".&&&&&&&&&+&&#@%#+@#@*$%&+$&&&&&&&&.";
+".&&&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&.";
+".&&&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&.";
+".&&&&&&&&@#@@$&*@&@#@#$#*#$&&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&&&.";
+".&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&&&&&.";
+".&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&.";
+".&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&&&&&.";
+".&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&&&&&.";
+".&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&.";
+".&&&&&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&.";
+".&&&&&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&.";
+".&&&&&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&.";
+".&&&&&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&.";
+".&&&&&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
+".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
+"...................................." |]
+
+
+
+let trashcan_closed_xpm = [|
+"64 80 17 1";
+" c None";
+". c #030304";
+"+ c #5A5A5C";
+"@ c #323231";
+"# c #888888";
+"$ c #1E1E1F";
+"% c #767677";
+"& c #494949";
+"* c #9E9E9C";
+"= c #111111";
+"- c #3C3C3D";
+"; c #6B6B6B";
+"> c #949494";
+", c #282828";
+"' c #808080";
+") c #545454";
+"! c #AEAEAC";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ==......=$$...=== ";
+" ..$------)+++++++++++++@$$... ";
+" ..=@@-------&+++++++++++++++++++-.... ";
+" =.$$@@@-&&)++++)-,$$$$=@@&+++++++++++++,..$ ";
+" .$$$$@@&+++++++&$$$@@@@-&,$,-++++++++++;;;&.. ";
+" $$$$,@--&++++++&$$)++++++++-,$&++++++;%%'%%;;$@ ";
+" .-@@-@-&++++++++-@++++++++++++,-++++++;''%;;;%*-$ ";
+" +------++++++++++++++++++++++++++++++;;%%%;;##*!. ";
+" =+----+++++++++++++++++++++++;;;;;;;;;;;;%'>>). ";
+" .=)&+++++++++++++++++;;;;;;;;;;;;;;%''>>#>#@. ";
+" =..=&++++++++++++;;;;;;;;;;;;;%###>>###+%== ";
+" .&....=-+++++%;;####''''''''''##'%%%)..#. ";
+" .+-++@....=,+%#####'%%%%%%%%%;@$-@-@*++!. ";
+" .+-++-+++-&-@$$=$=......$,,,@;&)+!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" =+-++-+++-+++++++++!++++!++++!+++!++!+++= ";
+" $.++-+++-+++++++++!++++!++++!+++!++!+.$ ";
+" =.++++++++++++++!++++!++++!+++!++.= ";
+" $..+++++++++++++++!++++++...$ ";
+" $$=.............=$$ ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" " |]
+
+let trashcan_open_xpm = [|
+"64 80 17 1";
+" c None";
+". c #030304";
+"+ c #5A5A5C";
+"@ c #323231";
+"# c #888888";
+"$ c #1E1E1F";
+"% c #767677";
+"& c #494949";
+"* c #9E9E9C";
+"= c #111111";
+"- c #3C3C3D";
+"; c #6B6B6B";
+"> c #949494";
+", c #282828";
+"' c #808080";
+") c #545454";
+"! c #AEAEAC";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" .=.==.,@ ";
+" ==.,@-&&&)-= ";
+" .$@,&++;;;%>*- ";
+" $,-+)+++%%;;'#+. ";
+" =---+++++;%%%;%##@. ";
+" @)++++++++;%%%%'#%$ ";
+" $&++++++++++;%%;%##@= ";
+" ,-++++)+++++++;;;'#%) ";
+" @+++&&--&)++++;;%'#'-. ";
+" ,&++-@@,,,,-)++;;;'>'+, ";
+" =-++&@$@&&&&-&+;;;%##%+@ ";
+" =,)+)-,@@&+++++;;;;%##%&@ ";
+" @--&&,,@&)++++++;;;;'#)@ ";
+" ---&)-,@)+++++++;;;%''+, ";
+" $--&)+&$-+++++++;;;%%'';- ";
+" .,-&+++-$&++++++;;;%''%&= ";
+" $,-&)++)-@++++++;;%''%), ";
+" =,@&)++++&&+++++;%'''+$@&++++++ ";
+" .$@-++++++++++++;'#';,........=$@&++++ ";
+" =$@@&)+++++++++++'##-.................=&++ ";
+" .$$@-&)+++++++++;%#+$.....................=)+ ";
+" $$,@-)+++++++++;%;@=........................,+ ";
+" .$$@@-++++++++)-)@=............................ ";
+" $,@---)++++&)@===............................,. ";
+" $-@---&)))-$$=..............................=)!. ";
+" --&-&&,,$=,==...........................=&+++!. ";
+" =,=$..=$+)+++++&@$=.............=$@&+++++!++!. ";
+" .)-++-+++++++++++++++++++++++++++!++!++!. ";
+" .+-++-+++++++++++++++++++++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!+++!!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" .+-++-+++-+++++++++!++++!++++!+++!++!++!. ";
+" =+-++-+++-+++++++++!++++!++++!+++!++!+++= ";
+" $.++-+++-+++++++++!++++!++++!+++!++!+.$ ";
+" =.++++++++++++++!++++!++++!+++!++.= ";
+" $..+++++++++++++++!++++++...$ ";
+" $$==...........==$$ ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" ";
+" " |]
+
+let window = GWindow.window ~title:"DnD Test" ()
+let _ = window#misc#realize ()
+
+let drag_icon =
+ GDraw.pixmap_from_xpm_d ~data:drag_icon_xpm ~window ()
+
+let trashcan_open =
+ GDraw.pixmap_from_xpm_d ~data:trashcan_open_xpm ~window ()
+
+let trashcan_closed =
+ GDraw.pixmap_from_xpm_d ~data:trashcan_closed_xpm ~window ()
+
+let targets = [
+ { target = "STRING"; flags = []; info = 0};
+ { target = "text/plain"; flags = []; info = 0};
+ { target = "text/uri-list"; flags = []; info = 2};
+ { target = "application/x-rootwin-drop"; flags = []; info = 1}
+]
+
+class drag_handler = object
+ method private beginning (_ : drag_context) = ()
+ method private data_delete (_ : drag_context) = ()
+ method private data_get (_ : drag_context) (_ : selection_data)
+ ~info:(_ : int) ~time:(_ : int) = ()
+ method private data_received (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
+ (_ : selection_data) ~info:(_ : int) ~time:(_ : int) = ()
+ method private drop (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
+ ~time:(_ : int) = false
+ method private ending (_ : drag_context) = ()
+ method private leave (_ : drag_context) ~time:(_ : int) = ()
+ method private motion (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
+ ~time:(_ : int) = false
+end
+
+
+class target_drag ?packing ?show () =
+ let pixmap = GMisc.pixmap trashcan_closed ?packing ?show () in
+object (self)
+ inherit widget pixmap#as_widget
+ inherit drag_handler
+ val mutable have_drag = false
+
+ method leave _ ~time =
+ print_endline "leave"; flush stdout;
+ have_drag <- false;
+ pixmap#set_pixmap trashcan_closed
+
+ method motion context ~x ~y ~time =
+ if not have_drag then begin
+ have_drag <- true;
+ pixmap#set_pixmap trashcan_open
+ end;
+ let source_typename =
+ try
+ context#source_widget#misc#get_type
+ with Gpointer.Null -> "unknown"
+ in
+ Printf.printf "motion, source %s\n" source_typename; flush stdout;
+ context#status [context#suggested_action] ~time;
+ true
+
+ method drop context ~x ~y ~time =
+ prerr_endline "drop"; flush stdout;
+ have_drag <- false;
+ pixmap#set_pixmap trashcan_closed;
+ match context#targets with
+ | [] -> false
+ | d :: _ -> pixmap#drag#get_data d ~context ~time; true
+
+ method data_received context ~x ~y data ~info ~time =
+ if data#format = 8 then begin
+ Printf.printf "Received \"%s\" in trashcan\n" data#data;
+ flush stdout;
+ context#finish ~success:true ~del:false ~time
+ end
+ else context#finish ~success:false ~del:false ~time
+
+ initializer
+ pixmap#drag#dest_set targets ~actions:[`COPY;`MOVE];
+ pixmap#drag#connect#leave ~callback:self#leave;
+ pixmap#drag#connect#motion ~callback:self#motion;
+ pixmap#drag#connect#drop ~callback:self#drop;
+ pixmap#drag#connect#data_received ~callback:self#data_received;
+ ()
+end
+
+class label_drag ?packing ?show () =
+ let label = GMisc.label ~text:"Drop Here\n" ?packing ?show () in
+object (self)
+ inherit widget label#as_widget
+ inherit drag_handler
+ method data_received context ~x ~y data ~info ~time =
+ if data#format = 8 then begin
+ Printf.printf "Received \"%s\" in label\n" data#data;
+ flush stdout;
+ context#finish ~success:true ~del:false ~time
+ end
+ else context#finish ~success:false ~del:false ~time
+
+ initializer
+ label#drag#dest_set targets ~actions:[`COPY; `MOVE ];
+ label#drag#connect#data_received ~callback:self#data_received;
+ ()
+end
+
+class source_drag ?packing ?show () =
+ let button = GButton.button ~label:"Drag Here\n" ?packing ?show () in
+object (self)
+ inherit widget button#as_widget
+ inherit drag_handler
+ method data_get _ data ~info ~time =
+ if info = 1 then begin
+ print_endline "I was dropped on the rootwin"; flush stdout
+ end
+ else if info = 2 then
+ data#set ~typ:data#target ~format:8
+ ~data:"file:///home/otaylor/images/weave.png"
+ else
+ data#set ~typ:data#target ~format:8 ~data:"I'm Data!"
+
+ method data_delete _ =
+ print_endline "Delete the data!"; flush stdout
+
+ initializer
+ button#drag#source_set targets
+ ~modi:[`BUTTON1; `BUTTON3 ] ~actions:[`COPY; `MOVE ];
+ button#drag#source_set_icon drag_icon;
+ button#drag#connect#data_get ~callback:self#data_get;
+ button#drag#connect#data_delete ~callback:self#data_delete;
+ ()
+end
+
+class popup () = object (self)
+ inherit drag_handler
+ val mutable popup_window = (None : GWindow.window option)
+ val mutable popped_up = false
+ val mutable in_popup = false
+ val mutable popdown_timer = None
+ val mutable popup_timer = None
+
+ method timer = popup_timer
+ method remove_timer () =
+ may popup_timer
+ ~f:(fun pdt -> Timeout.remove pdt; popup_timer <- None)
+ method add_timer time ~callback =
+ popup_timer <- Some (Timeout.add ~ms:time ~callback)
+
+ method popdown () =
+ popdown_timer <- None;
+ may popup_window ~f:(fun w -> w#misc#hide ());
+ popped_up <- false;
+ false
+
+ method motion (_ : drag_context) ~x ~y ~time =
+ if not in_popup then begin
+ in_popup <- true;
+ may popdown_timer ~f:
+ begin fun pdt ->
+ print_endline "removed popdown"; flush stdout;
+ Timeout.remove pdt;
+ popdown_timer <- None
+ end
+ end;
+ true
+
+ method leave (_ : drag_context) ~time =
+ if in_popup then begin
+ in_popup <- false;
+ if popdown_timer = None then begin
+ print_endline "added popdown"; flush stdout;
+ popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown)
+ end
+ end
+
+ method popup () =
+ if not popped_up then begin
+ if popup_window = None then begin
+ let w = GWindow.window ~kind:`POPUP ~position:`MOUSE () in
+ popup_window <- Some w;
+ let table = GPack.table ~rows:3 ~columns:3 ~packing:w#add () in
+ for i = 0 to 2 do
+ for j = 0 to 2 do
+ let button =
+ GButton.button ~label:(string_of_int i ^ "," ^ string_of_int j)
+ ~packing:(table#attach ~left:i ~top:j ~expand:`BOTH) ()
+ in
+ button#drag#dest_set targets ~actions:[`COPY; `MOVE ];
+ button#drag#connect#motion ~callback:self#motion;
+ button#drag#connect#leave ~callback:self#leave;
+ done
+ done
+ end;
+ may popup_window ~f:(fun w -> w#show ());
+ popped_up <- true
+ end;
+ popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown);
+ print_endline "added popdown"; flush stdout;
+ self#remove_timer ();
+ false
+end
+
+class popsite ?packing ?show () =
+ let label = GMisc.label ~text:"Popup\n" ?packing ?show ()
+ and popup = new popup () in
+object (self)
+ inherit widget label#as_widget
+ inherit drag_handler
+ method motion _ ~x ~y ~time =
+ if popup#timer = None then begin
+ print_endline "added popdown"; flush stdout;
+ popup#add_timer 500 ~callback:popup#popup
+ end;
+ true
+
+ method leave _ ~time =
+ popup#remove_timer ()
+
+ initializer
+ label#drag#dest_set targets ~actions:[`COPY; `MOVE ];
+ label#drag#connect#motion ~callback:self#motion;
+ label#drag#connect#leave ~callback:self#leave;
+ ()
+end
+
+let main () =
+ window#connect#destroy ~callback: Main.quit;
+ let table = GPack.table ~rows:2 ~columns:2 ~packing:window#add () in
+ let attach = table#attach ~expand:`BOTH in
+ new label_drag ~packing:(attach ~left:0 ~top:0) ();
+ new target_drag ~packing:(attach ~left:1 ~top:0) ();
+ new source_drag ~packing:(attach ~left:0 ~top:1) ();
+ new popsite ~packing:(attach ~left:1 ~top:1) ();
+
+ window#show ();
+ Main.main ()
+
+let _ =
+ main ()
projects / helm.git / blobdiff