[Lazarus] GTK2: Drag files to other applications (to the file manager, Thunar, Nautilus, etc)

[Bernd]

I am making progress. The handle is indeed a PGTKWidget but there are
always multiple widgets nested inside each other, for example a
TButton is really a GTKLabel inside a GTKButton inside a GTKEventBox,
so I have to recursively go through all the child widgets and set up
drag&drop for them all.

Here is what I have now (for everybody who also wants to experiment with this):

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, ComCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    StaticText1: TStaticText;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
{$ifdef LCLGTK2}
uses
  glib2, gtk2, gdk2;
{$endif}

{$R *.lfm}

{$ifdef LCLGTK2}
procedure GtkDragDataGet(GtkW: PGtkWidget;
                      Context: PGdkDragContext;
                      SelData: PGtkSelectionData;
                   TargetType: guint;
                         Time: guint;
                      Control: TWinControl); cdecl;
begin
  writeln('drag_data_get from ', Control.Name);
end;

procedure GtkDragBegin(GtkW: PGtkWidget;
                    Context: PGdkDragContext;
                    Control: TWinControl); cdecl;
begin
  writeln('drag_begin from ', Control.Name);
end;

procedure GtkRecursiveConnect(GtkW: PGtkWidget; Control: TWinControl); cdecl;
const
  FileDragTarget: TGtkTargetEntry = (target: 'text/uri-list'; flags:
0; info: 0;);
begin
  WriteLn('connecting: ', gtk_widget_get_name(GtkW));
  gtk_drag_source_set(GtkW, GDK_BUTTON1_MASK, @FileDragTarget, 1,
GDK_ACTION_COPY);
  g_signal_connect(GtkW, 'drag-data-get', TGCallback(@GtkDragDataGet), Control);
  g_signal_connect(GtkW, 'drag-begin', TGCallback(@GtkDragBegin), Control);

  // recurse through all child widgets
  if GTK_IS_CONTAINER(GtkW) then
    gtk_container_foreach(PGTKContainer(GtkW),
TGtkCallback(@GtkRecursiveConnect), Control);
end;

procedure GTkSetupDragDrop(AControl: TWinControl);
var
  GtkW: PGtkWidget;
begin
  writeln(LineEnding, 'now setting up: ', AControl.Name);
  GtkW := PGtkWidget(AControl.Handle);
  GtkRecursiveConnect(GtkW, AControl);
end;
{$endif}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  {$ifdef LCLGTK2}
  //SetupDragDrop(Form1);
  GTkSetupDragDrop(Button1);
  GTkSetupDragDrop(ScrollBox1);
  GTkSetupDragDrop(StaticText1);
  GTkSetupDragDrop(TreeView1);
  {$endif}
end;

end.

it prints the following to the console (and file manager and desktop
behave as if they would accept the file drop although it does not yet
send any data):

now setting up: Button1
connecting: GtkEventBox
connecting: GtkButton
connecting: GtkLabel

now setting up: ScrollBox1
connecting: GtkScrolledWindow
connecting: GtkLayout

now setting up: StaticText1
connecting: GtkFrame
connecting: GtkEventBox
connecting: GtkLabel

now setting up: TreeView1
connecting: LCLWinapiWidget
connecting: LCLWinapiClient
drag_begin from ScrollBox1
drag_begin from ScrollBox1
drag_data_get from ScrollBox1
drag_begin from StaticText1
drag_data_get from StaticText1
drag_begin from Button1
drag_data_get from Button1

The only thing that is not working is the TTreeView, it does not seem
to be based on any native GTK widget and will not behave like the
other widgets.