multiple-item drag-and-drop

["Jeffrey Ratcliffe" <jeffrey ratcliffe gmail com>]

I've been trying to get multiple-item drag-and-drop working in a
Simple::List. I started from

http://mail.gnome.org/archives/gtk-perl-list/2005-March/msg00155.html

The code below works (hardcoded to move - getting copy to work would
be the next step), except that the list doesn't scroll upwards. If I
comment out the $slist->drag_dest_set and $slist->drag_source_set,
then it scroll properly, but obviously with other errors.

Any ideas?

Thanks

Jeff

#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);             # To get TRUE and FALSE
use Gtk2 -init;
use Gtk2::Ex::Simple::List;
use Storable qw(freeze thaw);

my $win = Gtk2::Window->new;
$win->signal_connect (delete_event => sub { Gtk2->main_quit; });

my $scwin = Gtk2::ScrolledWindow -> new;
$win->add ($scwin);
$scwin -> set_policy ('automatic', 'automatic');

my $slist = Gtk2::Ex::Simple::List->new ( 'Int' => 'int' );
for (my $i = 1; $i < 21; $i++) {
 push @{$slist->{data}}, $i;
}
$slist -> set_reorderable( TRUE );
$slist -> get_selection -> set_mode ('multiple');

my $target_entry = {
 target => 'Glib::Scalar', # some string representing the drag type
 flags => 'same-widget',   # Gtk2::TargetFlags
 info => 1,                # some app-defined integer identifier
};
my @drag = ( 'move' );
# drag, = ( 'copy' ) if $drag_action & GTK_LS_DND_COPY;

$slist->drag_source_set('GDK_BUTTON1_MASK', \ @drag, $target_entry);


$slist->signal_connect('drag-data-get' => sub {
  my ($tree, $dnd, $sel) = @_;
  my $model = $tree->get_model;
  my @data = $tree->get_selection->get_selected_rows or return;
  my @valid;


  for (@data) {
    my $iter = $model->get_iter($_);
    my $info = $model->get($iter, 0);
    push @valid, $info;
  }


  return unless @valid;


  $sel->set($sel->target, 8, freeze(\ @valid));
});


$slist->signal_connect('drag-data-delete' => sub {
  my ($tree, $dnd) = @_;
  my $model = $tree->get_model;
  my @data = $tree->get_selection->get_selected_rows;


  for (reverse @data) {
    my $iter = $model->get_iter($_);
    my $info = $model->get($iter, 0);
    $model->remove($iter);
  }


  $tree->get_selection->unselect_all;
});


$slist->drag_dest_set(['motion', 'highlight'], \ @drag, $target_entry);


$slist->signal_connect('drag-data-received' => sub {
  my ($tree, $dnd, $x, $y, $sel) = @_;
  my ($path, $how) = $tree->get_dest_row_at_pos($x, $y);
  my $model = $tree->get_model;
  my $data = $sel->data or return;
  my $delete = $dnd->action() eq 'move';
  my $iter;


  $data = thaw($data);


  if ($path) {
    $iter = $model->get_iter($path);
    if ($how eq 'after' or $how eq 'into-or-after') {
      $iter = $model->insert_after($iter);
    }
    else { $iter = $model->insert_before($iter) }
  }
  else { $iter = $model->append }


  $model->set($iter, 0, shift @$data);
  $model->set($iter = $model->insert_after($iter), 0, $_) for @$data;
  $dnd->finish(1, $delete, time);
});


$slist->signal_connect('drag-drop' => sub {
  my ($tree, $dnd, $x, $y, $when) = @_;
  if (my $targ = $dnd->targets) {
    $tree->drag_get_data($dnd, $targ, $when);
    return 1;
  }
  return;
});

# If dragged below the bottom of the window, scroll it.
$slist->signal_connect('drag-motion' => sub {
 my ($tree, $dnd, $x, $y, $t) = @_;
 my ($path, $how) = $tree->get_dest_row_at_pos($x, $y) or return;
 my $scroll = $tree->parent;
 $tree->set_drag_dest_row($path, $how);

 my $adj = $scroll->get_vadjustment;
 my ($value, $step) = ($adj->value, $adj->step_increment);

 if ($y > $adj->page_size - $step/2) {
  my $v = $value + $step;
  my $m = $adj->upper - $adj->page_size;
  $adj->set_value($v > $m ? $m : $v);
 }
 elsif ($y < ($tree->get_headers_visible ? $step : $step/2)) {
  my $v = $value - $step;
  my $m = $adj->lower;
  $adj->set_value($v < $m ? $m : $v);
 }

 return FALSE;
});

$scwin -> add($slist);

$win->show_all;
Gtk2->main;