-----------------------------------------------------------------------
--          GtkAda - Ada95 binding for the Gimp Toolkit              --
--                                                                   --
--                     Copyright (C) 2000                            --
--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-----------------------------------------------------------------------

with Glib;          use Glib;
with Gdk.Font;      use Gdk.Font;
with Gtk.Box;       use Gtk.Box;
with Gtk.Dnd;       use Gtk.Dnd;
with Gtk.Selection; use Gtk.Selection;
with Gdk.Types;     use Gdk.Types;
with Gtk.Enums;     use Gtk.Enums;
with Gtk.Button;    use Gtk.Button;
with Gtk.Table;     use Gtk.Table;
with Gtk.Label;     use Gtk.Label;
with Gtk.Handlers;  use Gtk.Handlers;
with Gtk.Image;     use Gtk.Image;
with Gtkada.Types;  use Gtkada.Types;
with Gtk.Widget;    use Gtk.Widget;
with Gtk.Arguments; use Gtk.Arguments;
with Interfaces.C.Strings;
with Gdk.Pixmap;    use Gdk.Pixmap;
with Gdk.Bitmap;    use Gdk.Bitmap;
with Gdk.Color;     use Gdk.Color;
with Gdk.Window;    use Gdk.Window;
with Gtk.Frame;     use Gtk.Frame;

pragma Warnings (Off); --  Gtk.Text is obsolescent
with Gtk.Text;      use Gtk.Text;
pragma Warnings (On);

with Gdk.Dnd;       use Gdk.Dnd;

package body Create_Dnd is

   function "+" (S : String) return Interfaces.C.Strings.chars_ptr
                renames Interfaces.C.Strings.New_String;

   Drag_Icon_Xpm : constant Gtkada.Types.Chars_Ptr_Array
     := "36 48 9 1"
     + "       c None"
     + ".      c #020204"
     + "+      c #8F8F90"
     + "@      c #D3D3D2"
     + "#      c #AEAEAC"
     + "$      c #ECECEC"
     + "%      c #A2A2A4"
     + "&      c #FEFEFC"
     + "*      c #BEBEBC"
     + "               ....................."
     + "              ..&&&&&&&&&&&&&&&&&&&."
     + "             ...&&&&&&&&&&&&&&&&&&&."
     + "            ..&.&&&&&&&&&&&&&&&&&&&."
     + "           ..&&.&&&&&&&&&&&&&&&&&&&."
     + "          ..&&&.&&&&&&&&&&&&&&&&&&&."
     + "         ..&&&&.&&&&&&&&&&&&&&&&&&&."
     + "        ..&&&&&.&&&@&&&&&&&&&&&&&&&."
     + "       ..&&&&&&.*$%$+$&&&&&&&&&&&&&."
     + "      ..&&&&&&&.%$%$+&&&&&&&&&&&&&&."
     + "     ..&&&&&&&&.#&#@$&&&&&&&&&&&&&&."
     + "    ..&&&&&&&&&.#$**#$&&&&&&&&&&&&&."
     + "   ..&&&&&&&&&&.&@%&%$&&&&&&&&&&&&&."
     + "  ..&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&."
     + " ..&&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&."
     + "................&$@&&&@&&&&&&&&&&&&."
     + ".&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&&&&&."
     + ".&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&&&."
     + ".&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&&&."
     + ".&&&&&&@#@@$&*@&@#@#$**#$&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&@%&%$&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&+&$+&$&@&$@&&$@&&&&&&&&&&."
     + ".&&&&&&&&&+&&#@%#+@#@*$%&+$&&&&&&&&."
     + ".&&&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&."
     + ".&&&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&."
     + ".&&&&&&&&@#@@$&*@&@#@#$#*#$&&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&&&."
     + ".&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&&&&&."
     + ".&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&."
     + ".&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&&&&&."
     + ".&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&&&&&."
     + ".&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&."
     + ".&&&&&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&."
     + ".&&&&&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&."
     + ".&&&&&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&."
     + ".&&&&&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."
     + ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."
     + "....................................";

   Trashcan_Closed_Xpm : constant Gtkada.Types.Chars_Ptr_Array
     := "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"
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                       ==......=$$...===                        "
     + "                 ..$------)+++++++++++++@$$...                  "
     + "             ..=@@-------&+++++++++++++++++++-....              "
     + "          =.$$@@@-&&)++++)-,$$$$=@@&+++++++++++++,..$           "
     + "         .$$$$@@&+++++++&$$$@@@@-&,$,-++++++++++;;;&..          "
     + "        $$$$,@--&++++++&$$)++++++++-,$&++++++;%%'%%;;$@         "
     + "       .-@@-@-&++++++++-@++++++++++++,-++++++;''%;;;%*-$        "
     + "       +------++++++++++++++++++++++++++++++;;%%%;;##*!.        "
     + "        =+----+++++++++++++++++++++++;;;;;;;;;;;;%'>>).         "
     + "         .=)&+++++++++++++++++;;;;;;;;;;;;;;%''>>#>#@.          "
     + "          =..=&++++++++++++;;;;;;;;;;;;;%###>>###+%==           "
     + "           .&....=-+++++%;;####''''''''''##'%%%)..#.            "
     + "           .+-++@....=,+%#####'%%%%%%%%%;@$-@-@*++!.            "
     + "           .+-++-+++-&-@$$=$=......$,,,@;&)+!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           =+-++-+++-+++++++++!++++!++++!+++!++!+++=            "
     + "            $.++-+++-+++++++++!++++!++++!+++!++!+.$             "
     + "              =.++++++++++++++!++++!++++!+++!++.=               "
     + "                 $..+++++++++++++++!++++++...$                  "
     + "                      $$=.............=$$                       "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                ";

   Trashcan_Open_Xpm : constant Gtkada.Types.Chars_Ptr_Array :=
     "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"
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                      .=.==.,@                  "
     + "                                   ==.,@-&&&)-=                 "
     + "                                 .$@,&++;;;%>*-                 "
     + "                               $,-+)+++%%;;'#+.                 "
     + "                            =---+++++;%%%;%##@.                 "
     + "                           @)++++++++;%%%%'#%$                  "
     + "                         $&++++++++++;%%;%##@=                  "
     + "                       ,-++++)+++++++;;;'#%)                    "
     + "                      @+++&&--&)++++;;%'#'-.                    "
     + "                    ,&++-@@,,,,-)++;;;'>'+,                     "
     + "                  =-++&@$@&&&&-&+;;;%##%+@                      "
     + "                =,)+)-,@@&+++++;;;;%##%&@                       "
     + "               @--&&,,@&)++++++;;;;'#)@                         "
     + "              ---&)-,@)+++++++;;;%''+,                          "
     + "            $--&)+&$-+++++++;;;%%'';-                           "
     + "           .,-&+++-$&++++++;;;%''%&=                            "
     + "          $,-&)++)-@++++++;;%''%),                              "
     + "         =,@&)++++&&+++++;%'''+$@&++++++                        "
     + "        .$@-++++++++++++;'#';,........=$@&++++                  "
     + "       =$@@&)+++++++++++'##-.................=&++               "
     + "      .$$@-&)+++++++++;%#+$.....................=)+             "
     + "      $$,@-)+++++++++;%;@=........................,+            "
     + "     .$$@@-++++++++)-)@=............................            "
     + "     $,@---)++++&)@===............................,.            "
     + "    $-@---&)))-$$=..............................=)!.            "
     + "     --&-&&,,$=,==...........................=&+++!.            "
     + "      =,=$..=$+)+++++&@$=.............=$@&+++++!++!.            "
     + "           .)-++-+++++++++++++++++++++++++++!++!++!.            "
     + "           .+-++-+++++++++++++++++++++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!+++!!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           .+-++-+++-+++++++++!++++!++++!+++!++!++!.            "
     + "           =+-++-+++-+++++++++!++++!++++!+++!++!+++=            "
     + "            $.++-+++-+++++++++!++++!++++!+++!++!+.$             "
     + "              =.++++++++++++++!++++!++++!+++!++.=               "
     + "                 $..+++++++++++++++!++++++...$                  "
     + "                      $$==...........==$$                       "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                "
     + "                                                                ";


   Have_Drag : Boolean := False;

   Log : Gtk_Text;

   Drag_Icon            : Gdk_Pixmap;
   Drag_Mask            : Gdk_Bitmap;
   Trashcan_Open        : Gdk_Pixmap;
   Trashcan_Closed      : Gdk_Pixmap;
   Trashcan_Open_Mask   : Gdk_Bitmap;
   Trashcan_Closed_Mask : Gdk_Bitmap;

   My_Target_String1  : constant Guint := 0;
   My_Target_String2  : constant Guint := 1;
   My_Target_Url      : constant Guint := 2;
   My_Target_Rootwin  : constant Guint := 3;

   package Widget_Callback is new
     Gtk.Handlers.Callback (Gtk.Widget.Gtk_Widget_Record);
   package Return_Callback is new
     Gtk.Handlers.Return_Callback (Gtk.Widget.Gtk_Widget_Record, Boolean);

   Target_Table : constant Target_Entry_Array
     := ((+"STRING",        Target_No_Constraint, My_Target_String1),
         (+"text/plain",    Target_No_Constraint, My_Target_String2),
         (+"text/uri-list", Target_No_Constraint, My_Target_Url),
         (+"application/x-rootwin-drop", Target_No_Constraint,
          My_Target_Rootwin));
   --  all the known data types in this application. Any MIME type can be used,
   --  as well a strings defined in the motif protocol, like "STRING".

   Target_Table_String : constant Target_Entry_Array
     := ((+"STRING",        Target_No_Constraint, My_Target_String1),
         (+"text/plain",    Target_No_Constraint, My_Target_String2));
   --  For a drop site that only accepts Data of type STRING or text/plain

   Target_Table_Url : constant Target_Entry_Array
     := (1 => (+"text/uri-list", Target_No_Constraint, My_Target_Url));
   --  For a drop site that only accepts Data of type url.

   ----------
   -- Help --
   ----------

   function Help return String is
   begin
      return "This demo demonstrates the drag-and-drop features of GtkAda."
        & " Several @bdrag-and-drop@B (dnd) protocols are supported, so that"
        & " your application can easily communicate with other external codes,"
        & " but this is mostly transparent for you."
        & ASCII.LF
        & "Although providing dnd capabilities in your application is not"
        & " difficult, it requires you to take care of several things, which"
        & " might be a little bit tricky the first time. You should look at"
        & " this demo while reading its source code, extensively documented"
        & " in testgtk/create_dnd.adb in the GtkAda distribution."
        & ASCII.LF
        & "Several things worth noting in this demo:"
        & ASCII.LF
        & ASCII.LF
        & " - Several @bdrag sources@B are available. The first only knows"
        & " how to transmitted plain text data. The second one only knows"
        & " about URLs, whereas the third one can provide any of the above."
        & ASCII.LF
        & ASCII.LF
        & " - Several @bdrop sites@B are also provided. Like the drag sources,"
        & " they all have special attributes and accept only special types"
        & " of data. Thus, some dnd operations will simply be rejected if"
        & " there is no common type between the drag source and the drop site."
        & ASCII.LF
        & ASCII.LF
        & " - In addition, all of the above have special types of @bactions@B"
        & " that they can handle. These are either @bAction_Copy@B,"
        & " @bAction_Move@B, or a combination of the two. These actions"
        & " control the default behavior of the drag and drop operation. The"
        & " action selected will be the first one common to both the drag"
        & " source and the drop site, unless you press @bshift@B at the same"
        & " time to force a move. Notice than when Action_Move is selected,"
        & " GtkAda asks the drag source to delete the data, thus the Delete"
        & " message that you see on the output."
        & ASCII.LF
        & ASCII.LF
        & " - The @btrashcan@B has a special behavior, since no default"
        & " behavior is associated to it, and everything is managed directly"
        & " by the demo, by connecting to the appropriate signals. We also"
        & " chose to change its visual aspect when the mouse is over the"
        & " widget and a drag-and-drop operation is taking place."
        & ASCII.LF
        & ASCII.LF
        & " - The @bicons@B can be freely modified. Note that the pixmap used"
        & " when dragging from the first button is different than the one used"
        & " for the other buttons. This can provide some interesting visual"
        & " clues for the user.";
   end Help;


   -------------
   -- Put_Log --
   -------------

   procedure Put_Log (Str : String) is
   begin
      Insert (Log,
              Gdk.Font.Null_Font,
              Fore => Gdk.Color.Null_Color,
              Back => Gdk.Color.Null_Color,
              Chars => Str & ASCII.LF);
   end Put_Log;

   ----------------------
   -- Target_Drag_Drop --
   ----------------------
   --  A handler called for the signal "drag_drop", ie every time the user
   --  drops something on Widget.
   --  You need to provide such a handler when you do not provide any
   --  default behavior in Dest_Set, as is the case for the pixmap in Run.
   --
   --  Note that even if there is no common target between the drag source
   --  and the drop site, this handler is called anyway. However, since
   --  Get_Targets will return a Null_List, nothing will be printed.
   --
   --  This is the general form for handlers of "drag_drop".

   function Target_Drag_Drop
     (Widget : access Gtk_Widget_Record'Class;
      Args   : Gtk_Args) return Boolean
   is
      Context : Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      X       : Gint         := To_Gint (Args, 2);
      Y       : Gint         := To_Gint (Args, 3);
      Time    : Guint        := To_Guint (Args, 4);

      pragma Warnings (Off, Context);
      pragma Warnings (Off, X);
      pragma Warnings (Off, Y);
      pragma Warnings (Off, Time);

      use type Guint_List.Glist;

   begin
      Have_Drag := False;
      Put_Log ("Drop");
      Set (Gtk_Image (Widget), Trashcan_Closed, Trashcan_Closed_Mask);
      return False;
   end Target_Drag_Drop;

   -------------------------------
   -- Target_Drag_Data_Received --
   -------------------------------
   --  This function is called automatically every time some new data
   --  has been received on the trash can.
   --
   --  This is the general form of handlers for "drag_data_received".

   procedure Target_Drag_Data_Received
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      Args   : in Gtk_Args)
   is
      Context : constant Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      X    : Gint := To_Gint (Args, 2);
      Y    : Gint := To_Gint (Args, 3);
      Data : constant Selection_Data := Selection_Data (To_C_Proxy (Args, 4));
      Info : Guint := To_Guint (Args, 5); --  third item of the Target_Entry
      Time : constant Guint := To_Guint (Args, 6);

      pragma Warnings (Off, Widget);
      pragma Warnings (Off, X);
      pragma Warnings (Off, Y);
      pragma Warnings (Off, Info);
   begin
      if Get_Length (Data) >= 0
        and then Get_Format (Data) = 8
      then
         Put_Log ("Received " & Get_Data_As_String (Data) & " in trashcan");
         Finish
           (Context, Success => True, Del => False, Time => Guint32 (Time));
      else
         Finish
           (Context, Success => False, Del => False, Time => Guint32 (Time));
      end if;
   end Target_Drag_Data_Received;

   ------------------------
   -- Target_Drag_Motion --
   ------------------------
   --  This is the handler for the signal "drag_motion".
   --  It is called every time the user is doing a drag-and-drop operation, and
   --  the mouse is currently over Widget (but not released yet).
   --  This is used to change the visual aspect of Widget to provide visual
   --  clues to the user.
   --  This is the general form for handlers of "drag_motion".

   function Target_Drag_Motion  (Widget : access Gtk_Widget_Record'Class;
                                 Args   : Gtk_Args)
                                return Boolean
   is
      Context : constant Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      X       : Gint := To_Gint (Args, 2);
      Y       : Gint := To_Gint (Args, 3);
      Time    : constant Guint := To_Guint (Args, 4);

      pragma Warnings (Off, X);
      pragma Warnings (Off, Y);
      Toto : Gtk_Image;
   begin
      if not Have_Drag then
         Have_Drag := True;
         Toto := Gtk_Image (Widget);
         Set (Toto, Trashcan_Open, Trashcan_Open_Mask);
      end if;

      Drag_Status (Context, Get_Suggested_Action (Context), Guint32 (Time));

      return True;
   end Target_Drag_Motion;

   -----------------------
   -- Target_Drag_Leave --
   -----------------------
   --  A handler called whenever a drag-and-drop operation is being performed,
   --  and the mouse has just left the area covered by Widget on the screen.
   --  This is used to restore the default visual aspect of Widget.
   --
   --  Leave is also called when the drop is done on Widget.
   --
   --  This is the general form of handlers for "drag_leave".

   procedure Target_Drag_Leave (Widget : access Gtk_Widget_Record'Class;
                                Args   : Gtk_Args)
   is
      Context : Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      Time    : Guint := To_Guint (Args, 2);

      pragma Warnings (Off, Context);
      pragma Warnings (Off, Time);
   begin
      Put_Log ("Leave");
      Have_Drag := False;
      Set (Gtk_Image (Widget), Trashcan_Closed, Trashcan_Closed_Mask);
   end Target_Drag_Leave;

   ------------------------------
   -- Label_Drag_Data_Received --
   ------------------------------
   --  This function is called automatically every time some new data
   --  has been received on the label "Drop Here".
   --
   --  This is the general form of handlers for "drag_data_received".

   procedure Label_Drag_Data_Received
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      Args   : in Gtk_Args)
   is
      Context : constant Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      X    : Gint := To_Gint (Args, 2);
      Y    : Gint := To_Gint (Args, 3);
      Data : constant Selection_Data := Selection_Data (To_C_Proxy (Args, 4));
      Info : Guint := To_Guint (Args, 5); --  third item of the Target_Entry
      Time : constant Guint := To_Guint (Args, 6);

      pragma Warnings (Off, Widget);
      pragma Warnings (Off, X);
      pragma Warnings (Off, Y);
      pragma Warnings (Off, Info);
   begin
      --  Put_Log ("Selection=" & Atom_Name (Get_Selection (Data)));
      --  Put_Log ("Target="    & Atom_Name (Get_Target (Data)));
      --  Put_Log ("Type="      & Atom_Name (Get_Type (Data)));
      --  Put_Log ("Source Actions="
      --            & Drag_Action'Image (Get_Actions (Context)));
      --  Put_Log ("Suggested Action="
      --            & Drag_Action'Image (Get_Suggested_Action (Context)));
      --  Put_Log ("Action="   & Drag_Action'Image (Get_Action (Context)));

      if Get_Length (Data) >= 0
        and then Get_Format (Data) = 8
      then
         Put_Log ("Received "
                  & Get_Data_As_String (Data)
                  & " in label");
         Gtk.Dnd.Finish
           (Context, Success => True, Del => False, Time => Guint32 (Time));
      else
         Gtk.Dnd.Finish
           (Context, Success => False, Del => False, Time => Guint32 (Time));
      end if;
   end Label_Drag_Data_Received;

   --------------------------
   -- Source_Drag_Data_Get --
   --------------------------
   --  This is called when the user has dropped the item, and GtkAda needs
   --  to know what was actually dragged. The source widget should thus give
   --  some data, that will be transmitted to the drop widget through the
   --  signal "drag_data_received".
   --
   --  This is the general form of handlers for "drag_data_get".

   procedure Source_Drag_Data_Get
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      Args   : in Gtk_Args)
   is
      Context : Drag_Context := Drag_Context (To_C_Proxy (Args, 1));
      Data : constant Selection_Data := Selection_Data (To_C_Proxy (Args, 2));
      Info : constant Guint := To_Guint (Args, 3);
         --  third item of the Target_Entry
      Time    : Guint := To_Guint (Args, 4);

      pragma Warnings (Off, Widget);
      pragma Warnings (Off, Context);
      pragma Warnings (Off, Time);
   begin
      if Info = My_Target_Rootwin then
         Put_Log ("I was dropped on the root window");

      elsif Info = My_Target_Url then
         Selection_Data_Set (Data, Get_Target (Data), 8,
                             "file://www.act-europe.fr");

      else
         Selection_Data_Set (Data, Get_Target (Data), 8,
                             "I'm Data!, Info was " & Guint'Image (Info));
      end if;
   end Source_Drag_Data_Get;

   -----------------------------
   -- Source_Drag_Data_Delete --
   -----------------------------
   --  This handler is called whenever the drop site of a drag-and-drop
   --  operation has decided that the data should be deleted, or if the
   --  selected action was Action_Move.
   --
   --  This is the general handler type for "drag_data_delete".

   procedure Source_Drag_Data_Delete
     (Widget  : access Gtk.Widget.Gtk_Widget_Record'Class;
      Args    : Gtk_Args)
   is
      Context : Drag_Context := Drag_Context (To_C_Proxy (Args, 1));

      pragma Warnings (Off, Context);
      pragma Warnings (Off, Widget);
   begin
      Put_Log ("Delete the data!");
   end Source_Drag_Data_Delete;

   ---------
   -- Run --
   ---------

   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
      Table     : Gtk_Table;
      Label     : Gtk_Label;
      Button    : Gtk_Button;
      Pixmap    : Gtk_Image;
      Box       : Gtk_Box;
   begin
      Set_Label (Frame, "Drag-and-Drop");

      Gtk_New_Vbox (Box, Homogeneous => False);
      Add (Frame, Box);

      Gtk_New (Table, 3, 3, False);
      Pack_Start (Box, Table);

      Create_From_Xpm_D (Drag_Icon,
                         Null_Window,
                         Get_Colormap (Frame),
                         Drag_Mask,
                         Null_Color,
                         Drag_Icon_Xpm);
      Create_From_Xpm_D (Trashcan_Open,
                         Null_Window,
                         Get_Colormap (Frame),
                         Trashcan_Open_Mask,
                         Null_Color,
                         Trashcan_Open_Xpm);
      Create_From_Xpm_D (Trashcan_Closed,
                         Null_Window,
                         Get_Colormap (Frame),
                         Trashcan_Closed_Mask,
                         Null_Color,
                         Trashcan_Closed_Xpm);

      -----------------
      --  Drop sites --
      -----------------

      --  First drop site: a simple label

      Gtk_New (Label, "Drop plain text here." & ASCII.LF
               & "Action_Move only" & ASCII.LF);
      Gtk.Dnd.Dest_Set (Label,
                        Dest_Default_All,
                        Target_Table_String, -- only STRING or text/plain
                        Action_Move);
      Attach (Table, Label, 0, 1, 0, 1);

      Widget_Callback.Connect (Label, "drag_data_received",
                               Label_Drag_Data_Received'Access);

      --  Second drop site: a simple label

      Gtk_New (Label, "Drop Url here." & ASCII.LF
               & "Action_Copy or Action_Move" & ASCII.LF);
      Gtk.Dnd.Dest_Set (Label,
                        Dest_Default_All,
                        Target_Table_Url, -- only urls
                        Action_Copy + Action_Move);
      Attach (Table, Label, 1, 2, 0, 1);

      Widget_Callback.Connect (Label, "drag_data_received",
                               Label_Drag_Data_Received'Access);

      --  Third drop site: a simple label

      Gtk_New (Label, "Drop Anything" & ASCII.LF
               & "only Here" & ASCII.LF);
      Gtk.Dnd.Dest_Set (Label,
                        Dest_Default_All,
                        Target_Table, -- only urls
                        Action_Copy + Action_Move);
      Attach (Table, Label, 2, 3, 0, 1);

      Widget_Callback.Connect (Label, "drag_data_received",
                               Label_Drag_Data_Received'Access);

      -----------------
      --  Drag sites --
      -----------------

      --  First Drag site

      Gtk_New (Button, "Drag String from Here" & ASCII.LF);
      Gtk.Dnd.Source_Set (Button,
                          Button1_Mask or Button3_Mask,
                          Target_Table_String,
                          Action_Copy + Action_Move);
      Attach (Table, Button, 0, 1, 1, 2);

      Widget_Callback.Connect (Button, "drag_data_get",
                               Source_Drag_Data_Get'Access);
      Widget_Callback.Connect (Button, "drag_data_delete",
                               Source_Drag_Data_Delete'Access);

      Gtk.Dnd.Source_Set_Icon (Button,
                               Get_Colormap (Frame),
                               Drag_Icon, Drag_Mask);

      --  Second Drag site

      Gtk_New (Button, "Drag Url from Here" & ASCII.LF);
      Gtk.Dnd.Source_Set (Button,
                          Button1_Mask or Button3_Mask,
                          Target_Table_Url,
                          Action_Copy + Action_Move);
      Attach (Table, Button, 1, 2, 1, 2);

      Widget_Callback.Connect (Button, "drag_data_get",
                               Source_Drag_Data_Get'Access);
      Widget_Callback.Connect (Button, "drag_data_delete",
                               Source_Drag_Data_Delete'Access);

      --  Third Drag site

      Gtk_New (Button, "Drag String or" & ASCII.LF
               & "Url from Here" & ASCII.LF);
      Gtk.Dnd.Source_Set (Button,
                          Button1_Mask or Button3_Mask,
                          Target_Table,
                          Action_Copy + Action_Move + Action_Ask);
      Attach (Table, Button, 2, 3, 1, 2);

      Widget_Callback.Connect (Button, "drag_data_get",
                               Source_Drag_Data_Get'Access);
      Widget_Callback.Connect (Button, "drag_data_delete",
                               Source_Drag_Data_Delete'Access);

      --  Special drop site

      Gtk_New (Pixmap, Trashcan_Closed, Trashcan_Closed_Mask);
      Gtk.Dnd.Dest_Set (Pixmap);
      Attach (Table, Pixmap, 0, 1, 2, 3);

      Return_Callback.Connect (Pixmap, "drag_drop",
                               Target_Drag_Drop'Access);
      Widget_Callback.Connect (Pixmap, "drag_data_received",
                               Target_Drag_Data_Received'Access);
      Return_Callback.Connect (Pixmap, "drag_motion",
                               Target_Drag_Motion'Access);
      Widget_Callback.Connect (Pixmap, "drag_leave",
                               Target_Drag_Leave'Access);


      --  The log window
      Gtk_New (Log);
      Pack_Start (Box, Log);

      Show_All (Frame);
   end Run;

end Create_Dnd;
