X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Ftestdnd.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Ftestdnd.ml;h=0000000000000000000000000000000000000000;hp=8c10f7b984948f4e3da3e22fdfc94fdb498e2f3e;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/testdnd.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/testdnd.ml deleted file mode 100644 index 8c10f7b98..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/testdnd.ml +++ /dev/null @@ -1,510 +0,0 @@ -(* 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 ()