helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/testdnd.ml

   1 (* this is a translation in Caml of the gtk+ example testdnd.c  *)
   2
   3
   4 open Gaux
   5 open Gtk
   6 open GObj
   7 open GMain
   8
   9 (* GtkThread.start() *)
  10
  11 let drag_icon_xpm = [|
  12 "36 48 9 1";
  13 "       c None";
  14 ".      c #020204";
  15 "+      c #8F8F90";
  16 "@      c #D3D3D2";
  17 "#      c #AEAEAC";
  18 "$      c #ECECEC";
  19 "%      c #A2A2A4";
  20 "&      c #FEFEFC";
  21 "*      c #BEBEBC";
  22 "               .....................";
  23 "              ..&&&&&&&&&&&&&&&&&&&.";
  24 "             ...&&&&&&&&&&&&&&&&&&&.";
  25 "            ..&.&&&&&&&&&&&&&&&&&&&.";
  26 "           ..&&.&&&&&&&&&&&&&&&&&&&.";
  27 "          ..&&&.&&&&&&&&&&&&&&&&&&&.";
  28 "         ..&&&&.&&&&&&&&&&&&&&&&&&&.";
  29 "        ..&&&&&.&&&@&&&&&&&&&&&&&&&.";
  30 "       ..&&&&&&.*$%$+$&&&&&&&&&&&&&.";
  31 "      ..&&&&&&&.%$%$+&&&&&&&&&&&&&&.";
  32 "     ..&&&&&&&&.#&#@$&&&&&&&&&&&&&&.";
  33 "    ..&&&&&&&&&.#$**#$&&&&&&&&&&&&&.";
  34 "   ..&&&&&&&&&&.&@%&%$&&&&&&&&&&&&&.";
  35 "  ..&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&.";
  36 " ..&&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&.";
  37 "................&$@&&&@&&&&&&&&&&&&.";
  38 ".&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&&&&&.";
  39 ".&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&&&.";
  40 ".&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&&&.";
  41 ".&&&&&&@#@@$&*@&@#@#$**#$&&&&&&&&&&.";
  42 ".&&&&&&&&&&&&&&&&&&&@%&%$&&&&&&&&&&.";
  43 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
  44 ".&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&&&.";
  45 ".&&&&&&&&&+&$+&$&@&$@&&$@&&&&&&&&&&.";
  46 ".&&&&&&&&&+&&#@%#+@#@*$%&+$&&&&&&&&.";
  47 ".&&&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&.";
  48 ".&&&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&.";
  49 ".&&&&&&&&@#@@$&*@&@#@#$#*#$&&&&&&&&.";
  50 ".&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&&&.";
  51 ".&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&.";
  52 ".&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&&&&&.";
  53 ".&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&.";
  54 ".&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&&&&&.";
  55 ".&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&&&&&.";
  56 ".&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&&&&&.";
  57 ".&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&.";
  58 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
  59 ".&&&&&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&.";
  60 ".&&&&&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&.";
  61 ".&&&&&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&.";
  62 ".&&&&&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&.";
  63 ".&&&&&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&.";
  64 ".&&&&&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&.";
  65 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&.";
  66 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
  67 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
  68 ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&.";
  69 "...................................." |]
  70
  71
  72
  73 let trashcan_closed_xpm = [|
  74 "64 80 17 1";
  75 "       c None";
  76 ".      c #030304";
  77 "+      c #5A5A5C";
  78 "@      c #323231";
  79 "#      c #888888";
  80 "$      c #1E1E1F";
  81 "%      c #767677";
  82 "&      c #494949";
  83 "*      c #9E9E9C";
  84 "=      c #111111";
  85 "-      c #3C3C3D";
  86 ";      c #6B6B6B";
  87 ">      c #949494";
  88 ",      c #282828";
  89 "'      c #808080";
  90 ")      c #545454";
  91 "!      c #AEAEAC";
  92 "                                                                ";
  93 "                                                                ";
  94 "                                                                ";
  95 "                                                                ";
  96 "                                                                ";
  97 "                                                                ";
  98 "                                                                ";
  99 "                                                                ";
 100 "                                                                ";
 101 "                                                                ";
 102 "                                                                ";
 103 "                                                                ";
 104 "                                                                ";
 105 "                                                                ";
 106 "                                                                ";
 107 "                                                                ";
 108 "                                                                ";
 109 "                                                                ";
 110 "                                                                ";
 111 "                                                                ";
 112 "                                                                ";
 113 "                                                                ";
 114 "                       ==......=$$...===                        ";
 115 "                 ..$------)+++++++++++++@$$...                  ";
 116 "             ..=@@-------&+++++++++++++++++++-....              ";
 117 "          =.$$@@@-&&)++++)-,$$$$=@@&+++++++++++++,..$           ";
 118 "         .$$$$@@&+++++++&$$$@@@@-&,$,-++++++++++;;;&..          ";
 119 "        $$$$,@--&++++++&$$)++++++++-,$&++++++;%%'%%;;$@         ";
 120 "       .-@@-@-&++++++++-@++++++++++++,-++++++;''%;;;%*-$        ";
 121 "       +------++++++++++++++++++++++++++++++;;%%%;;##*!.        ";
 122 "        =+----+++++++++++++++++++++++;;;;;;;;;;;;%'>>).         ";
 123 "         .=)&+++++++++++++++++;;;;;;;;;;;;;;%''>>#>#@.          ";
 124 "          =..=&++++++++++++;;;;;;;;;;;;;%###>>###+%==           ";
 125 "           .&....=-+++++%;;####''''''''''##'%%%)..#.            ";
 126 "           .+-++@....=,+%#####'%%%%%%%%%;@$-@-@*++!.            ";
 127 "           .+-++-+++-&-@$$=$=......$,,,@;&)+!++!++!.            ";
 128 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 129 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 130 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 131 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 132 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 133 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 134 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 135 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 136 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 137 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 138 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 139 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 140 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 141 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 142 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 143 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 144 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 145 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 146 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 147 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 148 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 149 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 150 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 151 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 152 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 153 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 154 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 155 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 156 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 157 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 158 "           =+-++-+++-+++++++++!++++!++++!+++!++!+++=            ";
 159 "            $.++-+++-+++++++++!++++!++++!+++!++!+.$             ";
 160 "              =.++++++++++++++!++++!++++!+++!++.=               ";
 161 "                 $..+++++++++++++++!++++++...$                  ";
 162 "                      $$=.............=$$                       ";
 163 "                                                                ";
 164 "                                                                ";
 165 "                                                                ";
 166 "                                                                ";
 167 "                                                                ";
 168 "                                                                ";
 169 "                                                                ";
 170 "                                                                ";
 171 "                                                                "  |]
 172
 173 let trashcan_open_xpm = [|
 174 "64 80 17 1";
 175 "       c None";
 176 ".      c #030304";
 177 "+      c #5A5A5C";
 178 "@      c #323231";
 179 "#      c #888888";
 180 "$      c #1E1E1F";
 181 "%      c #767677";
 182 "&      c #494949";
 183 "*      c #9E9E9C";
 184 "=      c #111111";
 185 "-      c #3C3C3D";
 186 ";      c #6B6B6B";
 187 ">      c #949494";
 188 ",      c #282828";
 189 "'      c #808080";
 190 ")      c #545454";
 191 "!      c #AEAEAC";
 192 "                                                                ";
 193 "                                                                ";
 194 "                                                                ";
 195 "                                                                ";
 196 "                                                                ";
 197 "                                                                ";
 198 "                                      .=.==.,@                  ";
 199 "                                   ==.,@-&&&)-=                 ";
 200 "                                 .$@,&++;;;%>*-                 ";
 201 "                               $,-+)+++%%;;'#+.                 ";
 202 "                            =---+++++;%%%;%##@.                 ";
 203 "                           @)++++++++;%%%%'#%$                  ";
 204 "                         $&++++++++++;%%;%##@=                  ";
 205 "                       ,-++++)+++++++;;;'#%)                    ";
 206 "                      @+++&&--&)++++;;%'#'-.                    ";
 207 "                    ,&++-@@,,,,-)++;;;'>'+,                     ";
 208 "                  =-++&@$@&&&&-&+;;;%##%+@                      ";
 209 "                =,)+)-,@@&+++++;;;;%##%&@                       ";
 210 "               @--&&,,@&)++++++;;;;'#)@                         ";
 211 "              ---&)-,@)+++++++;;;%''+,                          ";
 212 "            $--&)+&$-+++++++;;;%%'';-                           ";
 213 "           .,-&+++-$&++++++;;;%''%&=                            ";
 214 "          $,-&)++)-@++++++;;%''%),                              ";
 215 "         =,@&)++++&&+++++;%'''+$@&++++++                        ";
 216 "        .$@-++++++++++++;'#';,........=$@&++++                  ";
 217 "       =$@@&)+++++++++++'##-.................=&++               ";
 218 "      .$$@-&)+++++++++;%#+$.....................=)+             ";
 219 "      $$,@-)+++++++++;%;@=........................,+            ";
 220 "     .$$@@-++++++++)-)@=............................            ";
 221 "     $,@---)++++&)@===............................,.            ";
 222 "    $-@---&)))-$$=..............................=)!.            ";
 223 "     --&-&&,,$=,==...........................=&+++!.            ";
 224 "      =,=$..=$+)+++++&@$=.............=$@&+++++!++!.            ";
 225 "           .)-++-+++++++++++++++++++++++++++!++!++!.            ";
 226 "           .+-++-+++++++++++++++++++++++!+++!++!++!.            ";
 227 "           .+-++-+++-+++++++++!+++!!++++!+++!++!++!.            ";
 228 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 229 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 230 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 231 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 232 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 233 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 234 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 235 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 236 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 237 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 238 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 239 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 240 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 241 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 242 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 243 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 244 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 245 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 246 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 247 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 248 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 249 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 250 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 251 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 252 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 253 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 254 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 255 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 256 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 257 "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            ";
 258 "           =+-++-+++-+++++++++!++++!++++!+++!++!+++=            ";
 259 "            $.++-+++-+++++++++!++++!++++!+++!++!+.$             ";
 260 "              =.++++++++++++++!++++!++++!+++!++.=               ";
 261 "                 $..+++++++++++++++!++++++...$                  ";
 262 "                      $$==...........==$$                       ";
 263 "                                                                ";
 264 "                                                                ";
 265 "                                                                ";
 266 "                                                                ";
 267 "                                                                ";
 268 "                                                                ";
 269 "                                                                ";
 270 "                                                                ";
 271 "                                                                "  |]
 272
 273 let window = GWindow.window ~title:"DnD Test" ()
 274 let _ = window#misc#realize ()
 275
 276 let drag_icon =
 277   GDraw.pixmap_from_xpm_d ~data:drag_icon_xpm ~window ()
 278
 279 let trashcan_open =
 280   GDraw.pixmap_from_xpm_d ~data:trashcan_open_xpm ~window ()
 281
 282 let trashcan_closed =
 283   GDraw.pixmap_from_xpm_d ~data:trashcan_closed_xpm ~window ()
 284
 285 let targets = [
 286   { target = "STRING"; flags = []; info = 0};
 287   { target = "text/plain"; flags = []; info = 0};
 288   { target = "text/uri-list"; flags = []; info = 2};
 289   { target = "application/x-rootwin-drop"; flags = []; info = 1}
 290 ]
 291
 292 class drag_handler = object
 293   method private beginning (_ : drag_context) = ()
 294   method private data_delete (_ : drag_context) = ()
 295   method private data_get (_ : drag_context) (_ : selection_data)
 296       ~info:(_ : int) ~time:(_ : int) = ()
 297   method private data_received (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
 298       (_ : selection_data) ~info:(_ : int) ~time:(_ : int) = ()
 299   method private drop (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
 300       ~time:(_ : int) = false
 301   method private ending (_ : drag_context) = ()
 302   method private leave (_ : drag_context) ~time:(_ : int) = ()
 303   method private motion (_ : drag_context) ~x:(_ : int) ~y:(_ : int)
 304       ~time:(_ : int) = false
 305 end
 306
 307
 308 class target_drag ?packing ?show () =
 309   let pixmap = GMisc.pixmap trashcan_closed ?packing ?show () in
 310 object (self)
 311   inherit widget pixmap#as_widget
 312   inherit drag_handler
 313   val mutable have_drag = false
 314
 315   method leave _ ~time =
 316     print_endline "leave"; flush stdout;
 317     have_drag <- false;
 318     pixmap#set_pixmap trashcan_closed
 319
 320   method motion context ~x ~y ~time =
 321     if not have_drag then begin
 322       have_drag <- true;
 323       pixmap#set_pixmap trashcan_open
 324     end;
 325     let source_typename =
 326       try
 327         context#source_widget#misc#get_type
 328       with Gpointer.Null -> "unknown"
 329     in
 330     Printf.printf "motion, source %s\n" source_typename; flush stdout;
 331     context#status [context#suggested_action] ~time;
 332     true
 333
 334   method drop context ~x ~y ~time =
 335     prerr_endline "drop"; flush stdout;
 336     have_drag <- false;
 337     pixmap#set_pixmap trashcan_closed;
 338     match context#targets with
 339     | [] -> false
 340     | d :: _ -> pixmap#drag#get_data d ~context ~time; true
 341
 342   method data_received context ~x ~y data ~info ~time =
 343     if data#format = 8 then begin
 344       Printf.printf "Received \"%s\" in trashcan\n" data#data;
 345       flush stdout;
 346       context#finish ~success:true ~del:false ~time
 347     end
 348     else context#finish ~success:false ~del:false ~time
 349
 350   initializer
 351     pixmap#drag#dest_set targets ~actions:[`COPY;`MOVE];
 352     pixmap#drag#connect#leave ~callback:self#leave;
 353     pixmap#drag#connect#motion ~callback:self#motion;
 354     pixmap#drag#connect#drop ~callback:self#drop;
 355     pixmap#drag#connect#data_received ~callback:self#data_received;
 356     ()
 357 end
 358
 359 class label_drag ?packing ?show () =
 360   let label = GMisc.label ~text:"Drop Here\n" ?packing ?show () in
 361 object (self)
 362   inherit widget label#as_widget
 363   inherit drag_handler
 364   method data_received context ~x ~y data ~info ~time =
 365     if data#format = 8 then  begin
 366       Printf.printf "Received \"%s\" in label\n" data#data;
 367       flush stdout;
 368       context#finish ~success:true ~del:false ~time
 369     end
 370     else context#finish ~success:false ~del:false ~time
 371
 372   initializer
 373     label#drag#dest_set targets ~actions:[`COPY; `MOVE ];
 374     label#drag#connect#data_received ~callback:self#data_received;
 375     ()
 376 end
 377
 378 class source_drag ?packing ?show () =
 379   let button = GButton.button ~label:"Drag Here\n" ?packing ?show () in
 380 object (self)
 381   inherit widget button#as_widget
 382   inherit drag_handler
 383   method data_get _ data ~info ~time =
 384     if info = 1 then begin
 385       print_endline "I was dropped on the rootwin"; flush stdout
 386     end
 387     else if info = 2 then
 388       data#set ~typ:data#target ~format:8
 389         ~data:"file:///home/otaylor/images/weave.png"
 390     else
 391       data#set ~typ:data#target ~format:8 ~data:"I'm Data!"
 392
 393   method data_delete _ =
 394     print_endline "Delete the data!"; flush stdout
 395
 396   initializer
 397     button#drag#source_set targets
 398       ~modi:[`BUTTON1; `BUTTON3 ] ~actions:[`COPY; `MOVE ];
 399     button#drag#source_set_icon drag_icon;
 400     button#drag#connect#data_get ~callback:self#data_get;
 401     button#drag#connect#data_delete ~callback:self#data_delete;
 402     ()
 403 end
 404
 405 class popup () = object (self)
 406   inherit drag_handler
 407   val mutable popup_window = (None : GWindow.window option)
 408   val mutable popped_up = false
 409   val mutable in_popup = false
 410   val mutable popdown_timer = None
 411   val mutable popup_timer = None
 412
 413   method timer = popup_timer
 414   method remove_timer () =
 415     may popup_timer
 416       ~f:(fun pdt -> Timeout.remove pdt; popup_timer <- None)
 417   method add_timer time ~callback =
 418     popup_timer <- Some (Timeout.add ~ms:time ~callback)
 419
 420   method popdown () =
 421     popdown_timer <- None;
 422     may popup_window ~f:(fun w -> w#misc#hide ());
 423     popped_up <- false;
 424     false
 425
 426   method motion (_ : drag_context) ~x ~y ~time =
 427     if not in_popup then begin
 428       in_popup <- true;
 429       may popdown_timer ~f:
 430         begin fun pdt ->
 431           print_endline "removed popdown"; flush stdout;
 432           Timeout.remove pdt;
 433           popdown_timer <- None
 434         end
 435     end;
 436     true
 437
 438   method leave (_ : drag_context) ~time =
 439     if in_popup then begin
 440       in_popup <- false;
 441       if popdown_timer = None then begin
 442         print_endline "added popdown"; flush stdout;
 443         popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown)
 444       end
 445     end
 446
 447   method popup () =
 448     if not popped_up then begin
 449       if popup_window = None then begin
 450         let w = GWindow.window ~kind:`POPUP ~position:`MOUSE () in
 451         popup_window <- Some w;
 452         let table = GPack.table ~rows:3 ~columns:3 ~packing:w#add () in
 453         for i = 0 to 2 do
 454           for j = 0 to 2 do
 455             let button =
 456               GButton.button ~label:(string_of_int i ^ "," ^ string_of_int j)
 457                 ~packing:(table#attach ~left:i ~top:j ~expand:`BOTH) ()
 458             in
 459             button#drag#dest_set targets ~actions:[`COPY; `MOVE ];
 460             button#drag#connect#motion ~callback:self#motion;
 461             button#drag#connect#leave ~callback:self#leave;
 462           done
 463         done
 464       end;
 465       may popup_window ~f:(fun w -> w#show ());
 466       popped_up <- true
 467     end;
 468     popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown);
 469     print_endline "added popdown"; flush stdout;
 470     self#remove_timer ();
 471     false
 472 end
 473
 474 class popsite ?packing ?show () =
 475   let label = GMisc.label ~text:"Popup\n" ?packing ?show ()
 476   and popup = new popup () in
 477 object (self)
 478   inherit widget label#as_widget
 479   inherit drag_handler
 480   method motion _ ~x ~y ~time =
 481     if popup#timer = None then begin
 482       print_endline "added popdown"; flush stdout;
 483       popup#add_timer 500 ~callback:popup#popup
 484     end;
 485     true
 486
 487   method leave _ ~time =
 488     popup#remove_timer ()
 489
 490   initializer
 491     label#drag#dest_set targets ~actions:[`COPY; `MOVE ];
 492     label#drag#connect#motion ~callback:self#motion;
 493     label#drag#connect#leave ~callback:self#leave;
 494     ()
 495 end
 496
 497 let main () =
 498   window#connect#destroy ~callback: Main.quit;
 499   let table = GPack.table ~rows:2 ~columns:2 ~packing:window#add () in
 500   let attach = table#attach ~expand:`BOTH in
 501   new label_drag ~packing:(attach ~left:0 ~top:0) ();
 502   new target_drag ~packing:(attach ~left:1 ~top:0) ();
 503   new source_drag ~packing:(attach ~left:0 ~top:1) ();
 504   new popsite ~packing:(attach ~left:1 ~top:1) ();
 505
 506   window#show ();
 507   Main.main ()
 508
 509 let _ =
 510   main ()