I've spent about 12 hours working on the following module. I provide its full source code (with POD) and its HTML-ized documentation. If you've got Gtk2, please try it out and provide any criticism, comments, and suggestions you have. I haven't done extensive testing on it, so please let me know if you find any bugs! In a few days, I'll submit it to CPAN.

Update: fixed a bug in widget() that wasn't calling cell() with the right values. Now the array-data-set with array-ref-of-column-names technique works.

Update: fixed the order of insertion when multiple items are moved from one window to the next. It had been backwards.

Documentation:

NAME
SYNOPSIS
DESCRIPTION

Constructor
Options

Orientation
Swapping Methods
Button Display
Selection Count
Scrollbar Policy

Columns and Data

Examples

Subclassing and Extending

Formatting Buttons
Creating Data Models
Populating a Cell
Moving Elements via Buttons
Moving Elements via Drag-and-Drop

LIMITATIONS
AUTHOR

NAME

Gtk2::Ex::ListSwap - Item swapping between two or three lists

SYNOPSIS

  use Gtk2::Ex::ListSwap;
  use Gtk2 -init;

  use strict;
  use warnings;

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

  my $list_swap = Gtk2::Ex::ListSwap->new;

  $list_swap->set_model(a => [
    { id => 'eggs', name => 'Eggs' },
    { id => 'cmilk', name => 'Chocolate Milk' },
    { id => 'oreo', name => 'Oreos', },
    { id => 'coke', name => 'Coca-Cola', },
  ]);
  $list_swap->set_model(b => [
    { id => 'bread', name => 'Whole Wheat Bread' },
    { id => 'lj', name => 'Lemon Juice' },
    { id => 'oj', name => 'Orange Juice' },
    { id => 'beer', name => 'Guiness' },
  ]);

  $list_swap->set_column_names(a => [['ID','id'], ['Name','name']]);
  $list_swap->set_column_names(b => [['ID','id'], ['Name','name']]);

  $window->add($list_swap->widget);
  $window->show_all;
  Gtk2->main;

DESCRIPTION

This module provides a simple factory for producing a widget containing two or three ScrollingWindow widgets with groups of buttons between them allowing for the movement of items from one list to another. It allows for a fair amount of customization: horizontal or vertical positioning, button-based and drag-and-drop methods for swapping elements, selection of which buttons to display, how many elements may be selected at once, and when scrollbars should be displayed.

Unlike standard widgets, a ListSwap widget is a Perl object which stores data about the widget, and it creates the widget only when the widget() method is called.

Constructor

A ListSwap object is created via

  my $ls = Gtk2::Ex::ListSwap->new;

Upon creation, a set of default options (explained next) are used.

Options

Orientation

The orientation of the widget is controlled via the set_orientation() method:

  $ls->set_orientation($how);

The orientation value can either be GTK_LS_HORIZONTAL or GTK_LS_VERTICAL. The default is GTK_LS_HORIZONTAL.

The get_orientation() method returns the orientation.

Swapping Methods

The methods by which elements can be swapped are controlled via the set_method() method:

  $ls->set_method($mask);

The method value is any bitwise combination of GTK_LS_BUTTONS and GTK_LS_DRAG_AND_DROP. The defaults is GTK_LS_BUTTONS | GTK_LS_DRAG_AND_DROP.

The get_method() method returns the swapping method.

Button Display

This determines which buttons will be displayed if button-swapping is enabled. The button display is controlled via the set_buttons() method:

  $ls->set_buttons($mask);

The button mask is any bitwise combination of the following constants: GTK_LS_A_TO_B, GTK_LS_B_TO_A, GTK_LS_ALL_A_TO_B, GTK_LS_ALL_B_TO_A, GTK_LS_A_TO_C, GTK_LS_C_TO_A, GTK_LS_B_TO_C, GTK_LS_C_TO_B, GTK_LS_ALL_A_TO_C, GTK_LS_ALL_B_TO_C, GTK_LS_ALL_C_TO_A, GTK_LS_ALL_C_TO_B. Also provided are two comprehensive masks: GTK_LS_ALL_AB_BUTTONS covers all buttons referring only to lists ``A'' and ``B''; GTK_LS_ALL_BUTTONS covers all buttons referring to lists ``A'', ``B'', and ``C''. If there are only two sets of data, GTK_LS_ALL_BUTTONS will not cause the widget to render buttons relating to the list ``C''. The default is GTK_LS_ALL_BUTTONS.

The get_buttons() method returns the mask of buttons.

Selection Count

The number of items allowed to be selected at once is controlled via the set_selection() method:

  $ls->set_selection($count);

The selection count is one of GTK_LS_SINGLE, GTK_LS_BROWSE, or GTK_LS_MULTIPLE. They correspond to their similarly-named Gtk counterparts (see the documentation at http://developer.gnome.org/doc/API/2.0/gtk/gtk-Standard-Enumerations.html#GtkSelectionMode). The default is GTK_LS_MULTIPLE.

The get_selection() method returns the selection mode.

Scrollbar Policy

The policy for scrollbars on the ScrollWindow widgets is controlled by the get_policy() method:

  $ls->set_policy($x_when, $y_when);

The policy values are any of GTK_LS_ALWAYS, GTK_LS_NEVER, and GTK_LS_AUTOMATIC. They correspond to their similarly-named Gtk counterparts (see the documentation at http://developer.gnome.org/doc/API/2.0/gtk/gtk-Standard-Enumerations.html#GtkPolicyType). The default is (GTK_LS_NEVER, GTK_LS_AUTOMATIC).

The get_policy() method returns the scrollbar policies. It returns an array reference or a list, depending on the context in which it is called.

Columns and Data

The widget can handle two or three sets of data. When the widget is created, it determines how many lists to render based on how many sets of data you have created. Data sets are created via the set_model() method.

  $ls->set_model(a => [
    { id => 'eggs', name => 'Eggs' },
    { id => 'cmilk', name => 'Chocolate Milk' },
    { id => 'oreo', name => 'Oreos', },
    { id => 'coke', name => 'Coca-Cola', },
  ]);

The first argument is either 'a', 'b', or 'c'. The second element is an array reference of rows. The contents of the rows must be references to arrays or hashes, and must be uniform for all data sets. That is, you cannot have one data set that holds array references and another data set that holds hash references within the same ListSwap widget. You also cannot mix the reference types within a single data set.

You can, of course, have data in your data sets that is not rendered in the list box.

You can retrieve a data set with the get_model() method, which takes the data set's name ('a', 'b', or 'c') as its argument.

The names of the columns and the mapping of the column name to the location in the row is done via the set_column_names() method:

  $ls->set_column_names(a => [
    ['ID','id'], ['Name','name']
  ]);

The first argument is either 'a', 'b', or 'c'. The second element is an array reference of column definitions. In the above example, the definitions are array references. The first element is the name for the column, and the second element is the index (or key) of the data set that refers to the value in that column. ['ID', 'id'] means that the column named ``ID'' will contain the values associated with the key ``id'' in the hash references that define the rows of data.

You can also use simple strings instead of array references, in which case the column names must exactly match the names of keys in the hash references that define your data. If your data is stored in array references, then each column name refers to a successive element in the array reference. (Examples follow.)

You can retrieve the column names and mappings with the get_column_names() method, which takes the data set's name ('a', 'b', or 'c') as its argument.

If you need to determine the number of data sets in this ListSwap object, use the get_size() method:

  my $n = $ls->get_size;

Examples

Here is data defined by hash references, with columns based on the keys in the hash:

  $ls->set_model(a => [
    { ID => 'A', Name => 'Alpha', },
    { ID => 'B', Name => 'Beta', },
    { ID => 'G', Name => 'Gamma' },
  ]);

  $ls->set_column_names(a => [
    qw( ID Name )
  ]);

Here is data defined by hash references, with columns that are mapped to keys in the hash:

  $ls->set_model(a => [
    { id => 'A', name => 'Alpha', },
    { id => 'B', name => 'Beta', },
    { id => 'G', name => 'Gamma' },
  ]);

  $ls->set_column_names(a => [
    [ Letter => 'id' ], [ Name => 'name' ]
  ]);

Here is data defined by array references, with columns that refer to sequential elements in the array:

  $ls->set_model(a => [
    [qw( A Alpha )],
    [qw( B Beta )],
    [qw( G Gamma )],
  ]);

  $ls->set_column_names(a => [
    qw( ID Name )
  ]);

Here is data defined by array references, with columns that are mapped to specific elements in the array:

  $ls->set_model(a => [
    [qw( A Alpha )],
    [qw( B Beta )],
    [qw( G Gamma )],
  ]);

  $ls->set_column_names(a => [
    [ ID => 0 ], [ Name => 1 ]
  ]);

Subclassing and Extending

Following is an explanation of the methods used in the creation and execution of the ListSwap widget.

Formatting Buttons

The most likely area of customization is the format of the buttons. Each button has two methods associated with it: one that creates the button widget, and one that takes that widget and connects to its ``clicked'' signal. For the button that moves the selected elements in list ``a'' to list ``b'', those methods are a_to_b_button() and a_to_b(). For the button that moves all elements in list ``a'' to list ``b'' those methods are all_a_to_b_button() and all_a_to_b(). The combinations in ``glob'' format are {all_,}{a,b,c}_to_{a,b,c}{_button,}, excluding the a_to_a variety.

Creating Data Models

The make_model() method takes the data structure representing rows of data and produces a Gtk2::ListStore object. The default method is very simple in nature:

  sub make_model {
    my ($self, $d) = @_;
    my $model = Gtk2::ListStore->new('Glib::Scalar');

    for (@$d) {
      my $iter = $model->append;
      $model->set($iter, 0, $_);
    }

    return $model;
  }

If you modify this method, you will most likely need to change all the following methods.

Populating a Cell

The cell() method populates a cell -- the value in a row for a given column. The method defaults to the following:

  sub cell {
    my ($self, $col, $cnum, $column, $cell, $model, $iter) = @_;
    my $info = $model->get($iter, 0);
    my $data = ref($info) eq 'ARRAY' ?
      $info->[ref($col) ? $col->[1] : $cnum] :
      $info->{ref($col) ? $col->[1] : $col};
    $cell->set(text => $data);
  }

There are two additional arguments to this function before the standard arguments to this GtkTreeCellDataFunc. They are the column definition (such as [ID = 'letter']>) and the column index (starting at 0). The other arguments are defined in the Gtk API documentation (see http://developer.gnome.org/doc/API/2.0/gtk/GtkTreeViewColumn.html#GtkTreeCellDataFunc).

Moving Elements via Buttons

The move() method takes two indices and an optional third argument which determines whether to move all the elements from one list to the other. The method defaults to the following:

  sub move {
    my ($self, $from_i, $to_i, $all) = @_;
    my @mod = qw( a b c );
    my $from = $self->get_model($mod[$from_i]);
    my $to = $self->get_model($mod[$to_i]);
    my $sel = $self->{trees}[$from_i]->get_selection;

    $sel->select_all if $all;
    my @data = $sel->get_selected_rows;

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

      $iter = $to->append;
      $to->set($iter, 0, $info);
    }
  }

This method is called in the ``clicked'' signal from the buttons created by the a_to_b() method and its siblings. List ``a'' is represented with 0, list ``b'' is represented by 1, and list ``c'' is represented by 2; thus, to move the selected elements in ``c'' to ``a'' use $self-move(2,0)>, and to move all elements in ``a'' to ``b'' use $self-move(0,1,1)>.

It's important to reverse the list of rows, because if you delete a row from a list and then move forward, you'll end up skipping what should have been the next row.

Moving Elements via Drag-and-Drop

NOTE: The Gtk2 API does not allow for dragging multiple items at once.

There are two methods used in dragging and dropping:

  sub dnd_get {
    my ($self, $src, $context, $sel, $id) = @_;
    my @data = $src->get_selection->get_selected_rows;
    my $model = $src->get_model;

    # @data really only holds one element :(
    for (reverse @data) {       
      my $iter = $model->get_iter($_);
      my $info = $model->get($iter, 0);
      $model->remove($iter);
      $sel->set($sel->target, 8, freeze($info));
    }
  }

  sub dnd_received {
    my ($self, $dst, $context, $x, $y, $sel) = @_;
    my ($path, $how) = $dst->get_dest_row_at_pos($x, $y);
    my $model = $dst->get_model;
    my $iter;

    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, thaw($sel->data));
  }

The arguments to these methods are defined in the Gtk API documentation (see http://developer.gnome.org/doc/API/2.0/gtk/GtkWidget.html#GtkWidget-drag-data-get and http://developer.gnome.org/doc/API/2.0/gtk/GtkWidget.html#GtkWidget-drag-data-received).

The dnd_get() method is called by the source list once its selected item has been dragged into the receiving list and dropped. After it is done executing, then the dnd_received() method is called by the receiving list.

LIMITATIONS

This module currently only provides support for moving elements to another list, not copying. This may change in future versions.

You can currently only drag one item at a time.

AUTHOR

Jeff japhy Pinyan, japhy@perlmonk.org

Source code:

package Gtk2::Ex::ListSwap;

use Gtk2;
use Carp qw( carp croak );
use Storable qw( freeze thaw );

use base 'Exporter';
@EXPORT = qw(
  GTK_LS_HORIZONTAL GTK_LS_VERTICAL

  GTK_LS_BUTTONS GTK_LS_DRAG_AND_DROP

  GTK_LS_A_TO_B GTK_LS_B_TO_A GTK_LS_ALL_A_TO_B GTK_LS_ALL_B_TO_A
  GTK_LS_A_TO_C GTK_LS_C_TO_A GTK_LS_ALL_A_TO_C GTK_LS_ALL_C_TO_A
  GTK_LS_B_TO_C GTK_LS_C_TO_B GTK_LS_ALL_B_TO_C GTK_LS_ALL_C_TO_B
  GTK_LS_ALL_AB_BUTTONS GTK_LS_ALL_BUTTONS

  GTK_LS_SINGLE GTK_LS_BROWSE GTK_LS_MULTIPLE

  GTK_LS_ALWAYS GTK_LS_NEVER GTK_LS_AUTOMATIC
);

use constant TRUE => 1;
use constant FALSE => 0;

# orientation constants
use constant GTK_LS_HORIZONTAL => 1;
use constant GTK_LS_VERTICAL => 2;

# swapping-method constants
use constant GTK_LS_BUTTONS       => 1 << 1;
use constant GTK_LS_DRAG_AND_DROP => 1 << 2;

# button constants
use constant GTK_LS_A_TO_B         => 1 << 1;
use constant GTK_LS_B_TO_A         => 1 << 2;
use constant GTK_LS_ALL_A_TO_B     => 1 << 3;
use constant GTK_LS_ALL_B_TO_A     => 1 << 4;
use constant GTK_LS_A_TO_C         => 1 << 5;
use constant GTK_LS_C_TO_A         => 1 << 6;
use constant GTK_LS_B_TO_C         => 1 << 7;
use constant GTK_LS_C_TO_B         => 1 << 8;
use constant GTK_LS_ALL_A_TO_C     => 1 << 9;
use constant GTK_LS_ALL_B_TO_C     => 1 << 10;
use constant GTK_LS_ALL_C_TO_A     => 1 << 11;
use constant GTK_LS_ALL_C_TO_B     => 1 << 12;
use constant GTK_LS_ALL_AB_BUTTONS => (1 << 5) - 1;
use constant GTK_LS_ALL_BUTTONS    => (1 << 13) - 1;

# selection constants
use constant GTK_LS_SINGLE   => 1;
use constant GTK_LS_BROWSE   => 2;
use constant GTK_LS_MULTIPLE => 3;

# policy constants
use constant GTK_LS_ALWAYS    => 1;
use constant GTK_LS_NEVER     => 2;
use constant GTK_LS_AUTOMATIC => 3;

$VERSION = '0.01b';

use strict;
use warnings;

sub new {
  my ($class) = @_;
  bless {
    orientation => GTK_LS_HORIZONTAL,
    buttons => GTK_LS_ALL_BUTTONS,
    selection => GTK_LS_MULTIPLE,
    method => GTK_LS_BUTTONS | GTK_LS_DRAG_AND_DROP,
    policy => ['never', 'automatic'],
  }, $class;
}


sub widget {
  my ($self) = @_;

  my $horiz = $self->get_orientation == GTK_LS_HORIZONTAL;
  my $num = $self->get_size;
  my $bflags = $self->get_buttons;
  my $hbox = 'Gtk2::HBox';
  my $vbox = 'Gtk2::VBox';

  my $main_container = ($vbox, $hbox)[$horiz];
  my $button_container = ($vbox, $hbox)[1-$horiz];
  my $widget = $main_container->new(FALSE, 4);
  my $ab_buttons = $button_container->new(FALSE, 4);
  my $bc_buttons = $button_container->new(FALSE, 4);

  my @lists = map Gtk2::ScrolledWindow->new, 1 .. $num;
  $_->set_policy($self->get_policy) for @lists;

  my @models = map $self->get_model($_), ('a' .. 'c')[0..$num-1];
  my @trees = map Gtk2::TreeView->new_with_model($_), @models;
  my @buttons = (
    $num == 2 ? [
      ($bflags & GTK_LS_ALL_A_TO_B ? 'all_a_to_b' : ()),
      ($bflags & GTK_LS_A_TO_B ? 'a_to_b' : ()),
      ($bflags & GTK_LS_B_TO_A ? 'b_to_a' : ()),
      ($bflags & GTK_LS_ALL_B_TO_A ? 'all_b_to_a' : ()),
    ] : (
      [
        ($bflags & GTK_LS_ALL_A_TO_C ? 'all_a_to_c' : ()),
        ($bflags & GTK_LS_A_TO_C ? 'a_to_c' : ()),
        ($bflags & GTK_LS_ALL_A_TO_B ? 'all_a_to_b' : ()),
        ($bflags & GTK_LS_A_TO_B ? 'a_to_b' : ()),
        ($bflags & GTK_LS_B_TO_A ? 'b_to_a' : ()),
        ($bflags & GTK_LS_ALL_B_TO_A ? 'all_b_to_a' : ()),
      ],
      [
        ($bflags & GTK_LS_ALL_B_TO_C ? 'all_b_to_c' : ()),
        ($bflags & GTK_LS_B_TO_C ? 'b_to_c' : ()),
        ($bflags & GTK_LS_C_TO_B ? 'c_to_b' : ()),
        ($bflags & GTK_LS_ALL_C_TO_B ? 'all_c_to_b' : ()),
        ($bflags & GTK_LS_C_TO_A ? 'c_to_a' : ()),
        ($bflags & GTK_LS_ALL_C_TO_A ? 'all_c_to_a' : ()),
      ]
    )
  );

  my $sel_mode = (qw( always never automatic ))[$self->get_selection -
+ 1];
  $_->get_selection->set_mode('multiple') for @trees;

  if ($self->get_method & GTK_LS_DRAG_AND_DROP) {
    my $entry = ['Glib::Scalar', 'same-app', 1];
    for (@trees) {
      $_->enable_model_drag_source('GDK_BUTTON1_MASK', 'GDK_ACTION_MOV
+E', $entry),
      $_->enable_model_drag_dest('GDK_ACTION_MOVE', $entry);
      $_->signal_connect('drag-data-get' => sub { $self->dnd_get(@_) }
+);
      $_->signal_connect('drag-data-received' => sub { $self->dnd_rece
+ived(@_) });
    }
  }

  $lists[$_]->add($trees[$_]) for 0 .. $num-1;

  my $cell = Gtk2::CellRendererText->new;
  for my $tree (0 .. $num-1) {
    my $cnum = 0;
    for my $col ($self->get_column_names((qw( a b c ))[$tree])) {
      my $n = $cnum;
      my $cname = ref($col) ? $col->[0] : $col;
      $trees[$tree]->insert_column_with_data_func(
        -1, $cname, $cell, sub { $self->cell($col, $n, @_) }
      );
      ++$cnum;
    }
  }

  if ($num == 2) {
    $widget->add($lists[0]);

    if ($self->get_method & GTK_LS_BUTTONS) {
      my $align = Gtk2::Alignment->new(0.5, 0.5, 0, 0);
      $ab_buttons->pack_start($self->$_, FALSE, FALSE, 4) for @{ $butt
+ons[0] };
      $align->add($ab_buttons);
      $widget->pack_start($align, FALSE, FALSE, 0);
    }

    $widget->add($lists[1]);
  }
  else {
    $widget->add($lists[0]);

    if ($self->get_method & GTK_LS_BUTTONS) {
      my $align = Gtk2::Alignment->new(0.5, 0.5, 0, 0);
      $ab_buttons->pack_start($self->$_, FALSE, FALSE, 4) for @{ $butt
+ons[0] };
      $align->add($ab_buttons);
      $widget->pack_start($align, FALSE, FALSE, 0);
    }

    $widget->add($lists[1]);

    if ($self->get_method & GTK_LS_BUTTONS) {
      my $align = Gtk2::Alignment->new(0.5, 0.5, 0, 0);
      $bc_buttons->pack_start($self->$_, FALSE, FALSE, 4) for @{ $butt
+ons[1] };
      $align->add($bc_buttons);
      $widget->pack_start($align, FALSE, FALSE, 0);
    }

    $widget->add($lists[2]);
  }

  $self->{trees} = \@trees;
  return $self->{widget} = $widget;
}


sub cell {
  my ($self, $col, $cnum, $column, $cell, $model, $iter) = @_;
  my $info = $model->get($iter, 0);
  my $data = ref($info) eq 'ARRAY' ?
    $info->[ref($col) ? $col->[1] : $cnum] :
    $info->{ref($col) ? $col->[1] : $col};
  $cell->set(text => $data);
}


sub move {
  my ($self, $from_i, $to_i, $all) = @_;
  my @mod = qw( a b c );
  my $from = $self->get_model($mod[$from_i]);
  my $to = $self->get_model($mod[$to_i]);
  my $sel = $self->{trees}[$from_i]->get_selection;

  $sel->select_all if $all;
  my @data = $sel->get_selected_rows;

  my $ins;

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

    $ins = $ins ? $to->insert_before($ins) : $to->append;
    $to->set($ins, 0, $info);
  }
}


sub dnd_get {
  my ($self, $src, $context, $sel, $id) = @_;
  my @data = $src->get_selection->get_selected_rows;
  my $model = $src->get_model;

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


sub dnd_received {
  my ($self, $dst, $context, $x, $y, $sel) = @_;
  my ($path, $how) = $dst->get_dest_row_at_pos($x, $y);
  my $model = $dst->get_model;
  my $iter;

  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, thaw($sel->data));
}


sub get_size {
  my ($self) = @_;
  return @{ $self->{models} };
}


sub set_orientation {
  my ($self, $o) = @_;
  croak "orientation must be either GTK_LS_HORIZONTAL or GTK_LS_VERTIC
+AL"
    unless $o == GTK_LS_HORIZONTAL or $o == GTK_LS_VERTICAL;
  $self->{orientation} = $o;
}


sub get_orientation {
  my ($self) = @_;
  return $self->{orientation};
}


sub set_method {
  my ($self, $m) = @_;
  croak "method must be a combination of GTK_LS_BUTTONS and GTK_LS_DRA
+G_AND_DROP"
    if $m & ~(GTK_LS_BUTTONS | GTK_LS_DRAG_AND_DROP);
  $self->{method} = $m;
}


sub get_method {
  my ($self) = @_;
  return $self->{method};
}


sub set_selection {
  my ($self, $s) = @_;
  croak "selection must be one of GTK_LS_SINGLE, GTK_LS_BROWSE, or GTK
+_LS_MULTIPLE"
    if $s != GTK_LS_SINGLE and $s != GTK_LS_BROWSE and $s != GTK_LS_MU
+LTIPLE;
  $self->{selection} = $s;
}


sub get_selection {
  my ($self) = @_;
  return $self->{selection};
}


sub set_buttons {
  my ($self, $b) = @_;
  my $valid = $self->get_size == 2 ?
    "GTK_LS_A_TO_B, GTK_LS_B_TO_A, GTK_LS_ALL_A_TO_B, GTK_LS_ALL_B_TO_
+A, and GTK_LS_ALL_AB_BUTTONS" :
    ("GTK_LS_A_TO_B, GTK_LS_B_TO_A, GTK_LS_ALL_A_TO_B, GTK_LS_ALL_B_TO
+_A, " .
     "GTK_LS_A_TO_C, GTK_LS_C_TO_A, GTK_LS_ALL_A_TO_C, GTK_LS_ALL_C_TO
+_A, " .
     "GTK_LS_B_TO_C, GTK_LS_C_TO_B, GTK_LS_ALL_B_TO_C, GTK_LS_ALL_C_TO
+_B, " .
     "GTK_LS_ALL_AB_BUTTONS, and GTK_LS_ALL_BUTTONS");
  croak "button flags must be a combination of $valid"
    if $b & ~($self->get_size == 2 ? GTK_LS_ALL_AB_BUTTONS : GTK_LS_AL
+L_BUTTONS);
  $self->{buttons} = $b;
}


sub get_buttons {
  my ($self) = @_;
  return $self->{buttons};
}


sub set_model {
  my ($self, $w, $d) = @_;
  my $i = { a => 0, b => 1, c => 2 }->{$w};
  $self->{models}[$i] = $self->make_model($d);
}


sub get_model {
  my ($self, $w) = @_;
  my $i = { a => 0, b => 1, c => 2 }->{$w};
  return $self->{models}[$i];
}


sub make_model {
  my ($self, $d) = @_;
  my $model = Gtk2::ListStore->new('Glib::Scalar');

  for (@$d) {
    my $iter = $model->append;
    $model->set($iter, 0, $_);
  }

  return $model;
}


sub set_column_names {
  my ($self, $w, $d) = @_;
  my $i = { a => 0, b => 1, c => 2 }->{$w};
  $self->{column_names}[$i] = $d;
}


sub get_column_names {
  my ($self, $w) = @_;
  my $i = { a => 0, b => 1, c => 2 }->{$w};
  return wantarray() ? @{ $self->{column_names}[$i] } : $self->{column
+_names}[$i];
}


sub set_policy {
  my ($self, $x, $y) = @_;
  croak "policies must be one of GTK_LS_ALWAYS, GTK_LS_NEVER, or GTK_L
+S_AUTOMATIC"
    unless ($x == GTK_LS_ALWAYS or $x == GTK_LS_NEVER or $x == GTK_LS_
+AUTOMATIC) and
           ($y == GTK_LS_ALWAYS or $y == GTK_LS_NEVER or $y == GTK_LS_
+AUTOMATIC);
  $self->{policy} = [$x, $y];
}


sub get_policy {
  my ($self) = @_;
  return wantarray() ? @{ $self->{policy} } : $self->{policy};
}


sub a_to_b {
  my ($self) = @_;
  my $button = $self->a_to_b_button;
  $button->signal_connect(clicked => sub { $self->move(0,1) });
  return $button;
}


sub a_to_b_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? ">" : "v");
}


sub a_to_c {
  my ($self) = @_;
  my $button = $self->a_to_c_button;
  $button->signal_connect(clicked => sub { $self->move(0,2) });
  return $button;
}


sub a_to_c_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "->" : "|\nv");
}


sub b_to_a {
  my ($self) = @_;
  my $button = $self->b_to_a_button;
  $button->signal_connect(clicked => sub { $self->move(1,0) });
  return $button;
}


sub b_to_a_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<" : "^");
}


sub b_to_c {
  my ($self) = @_;
  my $button = $self->b_to_c_button;
  $button->signal_connect(clicked => sub { $self->move(1,2) });
  return $button;
}


sub b_to_c_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? ">" : "v");
}


sub c_to_a {
  my ($self) = @_;
  my $button = $self->c_to_a_button;
  $button->signal_connect(clicked => sub { $self->move(2,0) });
  return $button;
}


sub c_to_a_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<-" : "^\n|");
}


sub c_to_b {
  my ($self) = @_;
  my $button = $self->c_to_b_button;
  $button->signal_connect(clicked => sub { $self->move(2,1) });
  return $button;
}


sub c_to_b_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<" : "^");
}


sub all_a_to_b {
  my ($self) = @_;
  my $button = $self->all_a_to_b_button;
  $button->signal_connect(clicked => sub { $self->move(0,1,1) });
  return $button;
}


sub all_a_to_b_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? ">>" : "v\nv");
}


sub all_a_to_c {
  my ($self) = @_;
  my $button = $self->all_a_to_c_button;
  $button->signal_connect(clicked => sub { $self->move(0,2,1) });
  return $button;
}


sub all_a_to_c_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "-->>" : "|\n|\nv\nv");
}


sub all_b_to_a {
  my ($self) = @_;
  my $button = $self->all_b_to_a_button;
  $button->signal_connect(clicked => sub { $self->move(1,0,1) });
  return $button;
}


sub all_b_to_a_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<<" : "^\n^");
}


sub all_b_to_c {
  my ($self) = @_;
  my $button = $self->all_b_to_c_button;
  $button->signal_connect(clicked => sub { $self->move(1,2,1) });
  return $button;
}


sub all_b_to_c_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? ">>" : "v\nv");
}


sub all_c_to_a {
  my ($self) = @_;
  my $button = $self->all_c_to_a_button;
  $button->signal_connect(clicked => sub { $self->move(2,0,1) });
  return $button;
}


sub all_c_to_a_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<<--" : "^\n^\n|\n|");
}


sub all_c_to_b {
  my ($self) = @_;
  my $button = $self->all_c_to_b_button;
  $button->signal_connect(clicked => sub { $self->move(2,1,1) });
  return $button;
}


sub all_c_to_b_button {
  my ($self) = @_;
  my $h = $self->get_orientation == GTK_LS_HORIZONTAL;
  return Gtk2::Button->new($h ? "<<" : "^\n^");
}


1;

__END__

=head1 NAME

Gtk2::Ex::ListSwap - Item swapping between two or three lists

=head1 SYNOPSIS

  use Gtk2::Ex::ListSwap;
  use Gtk2 -init;

  use strict;
  use warnings;

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

  my $list_swap = Gtk2::Ex::ListSwap->new;

  $list_swap->set_model(a => [
    { id => 'eggs', name => 'Eggs' },
    { id => 'cmilk', name => 'Chocolate Milk' },
    { id => 'oreo', name => 'Oreos', },
    { id => 'coke', name => 'Coca-Cola', },
  ]);
  $list_swap->set_model(b => [
    { id => 'bread', name => 'Whole Wheat Bread' },
    { id => 'lj', name => 'Lemon Juice' },
    { id => 'oj', name => 'Orange Juice' },
    { id => 'beer', name => 'Guiness' },
  ]);

  $list_swap->set_column_names(a => [['ID','id'], ['Name','name']]);
  $list_swap->set_column_names(b => [['ID','id'], ['Name','name']]);

  $window->add($list_swap->widget);
  $window->show_all;
  Gtk2->main;

=head1 DESCRIPTION

This module provides a simple factory for producing a widget containin
+g
two or three ScrollingWindow widgets with groups of buttons between th
+em
allowing for the movement of items from one list to another.  It allow
+s
for a fair amount of customization:  horizontal or vertical positionin
+g,
button-based and drag-and-drop methods for swapping elements, selectio
+n
of which buttons to display, how many elements may be selected at once
+,
and when scrollbars should be displayed.

Unlike standard widgets, a ListSwap widget is a Perl object which stor
+es
data about the widget, and it creates the widget only when the widget(
+)
method is called.

=head2 Constructor

A ListSwap object is created via

  my $ls = Gtk2::Ex::ListSwap->new;

Upon creation, a set of default options (explained next) are used.

=head2 Options

=head3 Orientation

The orientation of the widget is controlled via the set_orientation()
method:

  $ls->set_orientation($how);

The orientation value can either be C<GTK_LS_HORIZONTAL> or
C<GTK_LS_VERTICAL>.  The default is C<GTK_LS_HORIZONTAL>.

The get_orientation() method returns the orientation.

=head3 Swapping Methods

The methods by which elements can be swapped are controlled via the
set_method() method:

  $ls->set_method($mask);

The method value is any bitwise combination of C<GTK_LS_BUTTONS> and
C<GTK_LS_DRAG_AND_DROP>.  The defaults is
C<GTK_LS_BUTTONS | GTK_LS_DRAG_AND_DROP>.

The get_method() method returns the swapping method.

=head3 Button Display

This determines which buttons will be displayed if button-swapping
is enabled.  The button display is controlled via the set_buttons()
method:

  $ls->set_buttons($mask);

The button mask is any bitwise combination of the following constants:
C<GTK_LS_A_TO_B>, C<GTK_LS_B_TO_A>, C<GTK_LS_ALL_A_TO_B>, 
C<GTK_LS_ALL_B_TO_A>, C<GTK_LS_A_TO_C>, C<GTK_LS_C_TO_A>,
C<GTK_LS_B_TO_C>, C<GTK_LS_C_TO_B>, C<GTK_LS_ALL_A_TO_C>,
C<GTK_LS_ALL_B_TO_C>, C<GTK_LS_ALL_C_TO_A>, C<GTK_LS_ALL_C_TO_B>.
Also provided are two comprehensive masks:  C<GTK_LS_ALL_AB_BUTTONS>
covers all buttons referring only to lists "A" and "B";
C<GTK_LS_ALL_BUTTONS> covers all buttons referring to lists "A", "B",
and "C".  If there are only two sets of data, C<GTK_LS_ALL_BUTTONS> wi
+ll
not cause the widget to render buttons relating to the list "C".  The
default is C<GTK_LS_ALL_BUTTONS>.

The get_buttons() method returns the mask of buttons.

=head3 Selection Count

The number of items allowed to be selected at once is controlled via t
+he
set_selection() method:

  $ls->set_selection($count);

The selection count is one of C<GTK_LS_SINGLE>, C<GTK_LS_BROWSE>, or
C<GTK_LS_MULTIPLE>.  They correspond to their similarly-named Gtk
counterparts (see the documentation at L<http://developer.gnome.org/do
+c/API/2.0/gtk/gtk-Standard-Enumerations.html#GtkSelectionMode>).
The default is C<GTK_LS_MULTIPLE>.

The get_selection() method returns the selection mode.

=head3 Scrollbar Policy

The policy for scrollbars on the ScrollWindow widgets is controlled by
the get_policy() method:

  $ls->set_policy($x_when, $y_when);

The policy values are any of C<GTK_LS_ALWAYS>, C<GTK_LS_NEVER>, and
C<GTK_LS_AUTOMATIC>.  They correspond to their similarly-named Gtk
counterparts (see the documentation at L<http://developer.gnome.org/do
+c/API/2.0/gtk/gtk-Standard-Enumerations.html#GtkPolicyType>).
The default is C<(GTK_LS_NEVER, GTK_LS_AUTOMATIC)>.

The get_policy() method returns the scrollbar policies.  It returns an
array reference or a list, depending on the context in which it is cal
+led.

=head2 Columns and Data

The widget can handle two or three sets of data.  When the widget is
created, it determines how many lists to render based on how many sets
of data you have created.  Data sets are created via the set_model()
method.

  $ls->set_model(a => [
    { id => 'eggs', name => 'Eggs' },
    { id => 'cmilk', name => 'Chocolate Milk' },
    { id => 'oreo', name => 'Oreos', },
    { id => 'coke', name => 'Coca-Cola', },
  ]);

The first argument is either 'a', 'b', or 'c'.  The second element is
an array reference of rows.  The contents of the rows must be referenc
+es
to arrays or hashes, and B<must be uniform for all data sets>.  That i
+s,
you cannot have one data set that holds array references and another d
+ata
set that holds hash references within the same ListSwap widget.  You a
+lso
cannot mix the reference types within a single data set.

You can, of course, have data in your data sets that is not rendered i
+n
the list box.

You can retrieve a data set with the get_model() method, which takes t
+he
data set's name ('a', 'b', or 'c') as its argument.

The names of the columns and the mapping of the column name to the
location in the row is done via the set_column_names() method:

  $ls->set_column_names(a => [
    ['ID','id'], ['Name','name']
  ]);

The first argument is either 'a', 'b', or 'c'.  The second element is
an array reference of column definitions.  In the above example, the
definitions are array references.  The first element is the name for t
+he
column, and the second element is the index (or key) of the data set
that refers to the value in that column.  C<['ID', 'id']> means that t
+he
column named "ID" will contain the values associated with the key "id"
in the hash references that define the rows of data.

You can also use simple strings instead of array references, in which
case the column names must exactly match the names of keys in the hash
references that define your data.  If your data is stored in array
references, then each column name refers to a successive element in th
+e
array reference.  (Examples follow.)

You can retrieve the column names and mappings with the get_column_nam
+es()
method, which takes the data set's name ('a', 'b', or 'c') as its argu
+ment.

If you need to determine the number of data sets in this ListSwap obje
+ct,
use the get_size() method:

  my $n = $ls->get_size;

=head3 Examples

Here is data defined by hash references, with columns based on the key
+s
in the hash:

  $ls->set_model(a => [
    { ID => 'A', Name => 'Alpha', },
    { ID => 'B', Name => 'Beta', },
    { ID => 'G', Name => 'Gamma' },
  ]);

  $ls->set_column_names(a => [
    qw( ID Name )
  ]);

Here is data defined by hash references, with columns that are mapped 
+to
keys in the hash:

  $ls->set_model(a => [
    { id => 'A', name => 'Alpha', },
    { id => 'B', name => 'Beta', },
    { id => 'G', name => 'Gamma' },
  ]);

  $ls->set_column_names(a => [
    [ Letter => 'id' ], [ Name => 'name' ]
  ]);

Here is data defined by array references, with columns that refer to
sequential elements in the array:

  $ls->set_model(a => [
    [qw( A Alpha )],
    [qw( B Beta )],
    [qw( G Gamma )],
  ]);

  $ls->set_column_names(a => [
    qw( ID Name )
  ]);

Here is data defined by array references, with columns that are mapped
to specific elements in the array:

  $ls->set_model(a => [
    [qw( A Alpha )],
    [qw( B Beta )],
    [qw( G Gamma )],
  ]);

  $ls->set_column_names(a => [
    [ ID => 0 ], [ Name => 1 ]
  ]);

=head2 Subclassing and Extending

Following is an explanation of the methods used in the creation and
execution of the ListSwap widget.

=head3 Formatting Buttons

The most likely area of customization is the format of the buttons.  E
+ach
button has two methods associated with it:  one that creates the butto
+n
widget, and one that takes that widget and connects to its "clicked"
signal.  For the button that moves the selected elements in list "a" t
+o
list "b", those methods are a_to_b_button() and a_to_b().  For the but
+ton
that moves all elements in list "a" to list "b" those methods are
all_a_to_b_button() and all_a_to_b().  The combinations in "glob" form
+at
are {all_,}{a,b,c}_to_{a,b,c}{_button,}, excluding the a_to_a variety.

=head3 Creating Data Models

The make_model() method takes the data structure representing rows of
data and produces a Gtk2::ListStore object.  The default method is ver
+y
simple in nature:

  sub make_model {
    my ($self, $d) = @_;
    my $model = Gtk2::ListStore->new('Glib::Scalar');

    for (@$d) {
      my $iter = $model->append;
      $model->set($iter, 0, $_);
    }

    return $model;
  }

If you modify this method, you will most likely need to change all the
following methods.

=head3 Populating a Cell

The cell() method populates a cell -- the value in a row for a given
column.  The method defaults to the following:

  sub cell {
    my ($self, $col, $cnum, $column, $cell, $model, $iter) = @_;
    my $info = $model->get($iter, 0);
    my $data = ref($info) eq 'ARRAY' ?
      $info->[ref($col) ? $col->[1] : $cnum] :
      $info->{ref($col) ? $col->[1] : $col};
    $cell->set(text => $data);
  }

There are two additional arguments to this function before the standar
+d
arguments to this GtkTreeCellDataFunc.  They are the column definition
(such as C<[ID => 'letter']>) and the column index (starting at 0).  T
+he
other arguments are defined in the Gtk API documentation (see
L<http://developer.gnome.org/doc/API/2.0/gtk/GtkTreeViewColumn.html#Gt
+kTreeCellDataFunc>).

=head3 Moving Elements via Buttons

The move() method takes two indices and an optional third argument whi
+ch
determines whether to move all the elements from one list to the other
+.
The method defaults to the following:

  sub move {
    my ($self, $from_i, $to_i, $all) = @_;
    my @mod = qw( a b c );
    my $from = $self->get_model($mod[$from_i]);
    my $to = $self->get_model($mod[$to_i]);
    my $sel = $self->{trees}[$from_i]->get_selection;

    $sel->select_all if $all;
    my @data = $sel->get_selected_rows;

    my $ins;

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

      $ins = $ins ? $to->insert_before($ins) : $to->append;
      $to->set($ins, 0, $info);
    }
  }

This method is called in the "clicked" signal from the buttons created
+ by
the a_to_b() method and its siblings.  List "a" is represented with 0,
list "b" is represented by 1, and list "c" is represented by 2; thus, 
+to
move the selected elements in "c" to "a" use C<$self->move(2,0)>, and 
+to
move B<all> elements in "a" to "b" use C<$self->move(0,1,1)>.

It's important to reverse the list of rows, because if you delete a ro
+w
from a list and then move forward, you'll end up skipping what should 
+have
been the next row.

=head3 Moving Elements via Drag-and-Drop

B<NOTE:> The Gtk2 API does not allow for dragging multiple items at on
+ce.

There are two methods used in dragging and dropping:

  sub dnd_get {
    my ($self, $src, $context, $sel, $id) = @_;
    my @data = $src->get_selection->get_selected_rows;
    my $model = $src->get_model;

    # @data really only holds one element :(
    for (reverse @data) {    
      my $iter = $model->get_iter($_);
      my $info = $model->get($iter, 0);
      $model->remove($iter);
      $sel->set($sel->target, 8, freeze($info));
    }
  }

  sub dnd_received {
    my ($self, $dst, $context, $x, $y, $sel) = @_;
    my ($path, $how) = $dst->get_dest_row_at_pos($x, $y);
    my $model = $dst->get_model;
    my $iter;

    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, thaw($sel->data));
  }

The arguments to these methods are defined in the Gtk API documentatio
+n
(see L<http://developer.gnome.org/doc/API/2.0/gtk/GtkWidget.html#GtkWi
+dget-drag-data-get>
and L<http://developer.gnome.org/doc/API/2.0/gtk/GtkWidget.html#GtkWid
+get-drag-data-received>).

The dnd_get() method is called by the source list once its selected it
+em
has been dragged into the receiving list and dropped.  After it is don
+e
executing, then the dnd_received() method is called by the receiving l
+ist.

=head1 LIMITATIONS

This module currently only provides support for I<moving> elements to
another list, not I<copying>.  This may change in future versions.

You can currently only drag one item at a time.

=head1 AUTHOR

Jeff C<japhy> Pinyan, F<japhy@perlmonk.org>

=cut
[download]

_____________________________________________________
Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

In reply to RFC on Gtk2::Ex::ListSwap by japhy

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.