# Copyright 2008, 2009, 2010 Kevin Ryde

# This file is part of Gtk2-Ex-ListModelConcat.
#
# Gtk2-Ex-ListModelConcat 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 3, or (at your option) any
# later version.
#
# Gtk2-Ex-ListModelConcat 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 Gtk2-Ex-ListModelConcat.  If not, see <http://www.gnu.org/licenses/>.


package Gtk2::Ex::ListModelConcat;
use 5.008;
use strict;
use warnings;
# 1.201 for drag_data_get() stack fix, and multi-column $model->get() fix
use Gtk2 1.201;
use Carp;
use List::Util qw(min max);
use Scalar::Util 1.18; # 1.18 for pure-perl refaddr() fix
use Gtk2::Ex::TreeModel::ImplBits;

# uncomment this to run the ### lines
#use Smart::Comments;

our $VERSION = 7;

use Glib::Object::Subclass
  'Glib::Object',
  interfaces => [ 'Gtk2::TreeModel',
                  'Gtk2::TreeDragSource',
                  'Gtk2::TreeDragDest' ],
  properties => [ Glib::ParamSpec->scalar
                  ('models',
                   'models',
                   'Arrayref of list model objects to concatenate.',
                   Glib::G_PARAM_READWRITE)
                ];

sub INIT_INSTANCE {
  my ($self) = @_;
  Gtk2::Ex::TreeModel::ImplBits::random_stamp ($self);
  $self->{'models'} = [];
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  ### ListModelConcat SET_PROPERTY: $pname

  if ($pname eq 'models') {
    foreach my $model (@$newval) {
      $model->isa('Gtk2::TreeModel') or croak "not a TreeModel: $model";
    }
    my $models = $self->{'models'};
    @$models = @$newval;  # copy input

    require Glib::Ex::SignalIds;
    my @signals;
    $self->{'signals'} = \@signals;
    my %done_reordered;

    foreach my $i (0 .. $#$models) {
      my $model = $models->[$i];
      my $userdata = [ $self, $i ];
      # weaken to avoid a circular reference which would prevent a Concat
      # containing models from being garbage collected
      Scalar::Util::weaken ($userdata->[0]);

      # the reordered signal is only connected once if the model appears
      # multiple times
      my @reordered;
      $done_reordered{Scalar::Util::refaddr($model)} ||= do {
        push @reordered, $model->signal_connect
          (rows_reordered => \&_do_rows_reordered, $userdata);
        1;
      };
      push @signals, Glib::Ex::SignalIds->new
        ($model,
         $model->signal_connect (row_changed => \&_do_row_changed, $userdata),
         $model->signal_connect (row_deleted => \&_do_row_deleted, $userdata),
         $model->signal_connect (row_inserted=> \&_do_row_inserted,$userdata),
         @reordered);
    }

  } else {
    $self->{$pname} = $newval;  # per default GET_PROPERTY
  }
}

# gtk_tree_model_get_flags
#
use constant GET_FLAGS => [ 'list-only' ];

# gtk_tree_model_get_n_columns
#
sub GET_N_COLUMNS {
  my ($self) = @_;
  ### ListModelConcat get_n_columns
  my $model = $self->{'models'}->[0]
    || return 0; # when no models
  return $model->get_n_columns;
}

# gtk_tree_model_get_column_type
#
sub GET_COLUMN_TYPE {
  my ($self, $col) = @_;
  #### ListModelConcat get_column_type
  my $model = $self->{'models'}->[0] or _no_submodels('get_column_type');
  return $model->get_column_type ($col);
}

# gtk_tree_model_get_iter
#
sub GET_ITER {
  my ($self, $path) = @_;
  #### ListModelConcat get_iter, path: $path->to_string
  if ($path->get_depth != 1) { return undef; }
  my ($index) = $path->get_indices;
  if ($index >= _total_length($self)) { return undef; }
  return _index_to_iter ($self, $index);
}

# gtk_tree_model_get_path
#
sub GET_PATH {
  my ($self, $iter) = @_;
  #### ListModelConcat get_path
  return Gtk2::TreePath->new_from_indices (_iter_to_index ($self, $iter));
}

# gtk_tree_model_get_value
#
sub GET_VALUE {
  my ($self, $iter, $col) = @_;
  #### ListModelConcat get_value iter: $iter->[0],$iter->[1]
  #### col: $col
  my $index = _iter_to_index ($self, $iter);
  my ($model, $subiter) = _index_to_subiter ($self, $index);
  return $model->get_value ($subiter, $col);
}

# gtk_tree_model_iter_next
#
sub ITER_NEXT {
  my ($self, $iter) = @_;
  #### ListModelConcat iter_next
  my $index = _iter_to_index ($self, $iter);
  $index++;
  if ($index < _total_length($self)) {
    return _index_to_iter ($self, $index);
  } else {
    return undef;
  }
}

# gtk_tree_model_iter_has_child
# my ($self, $iter) = @_;
# $iter never undef here, so always asking about an ordinary row, and
# there's nothing under the rows
#
use constant ITER_HAS_CHILD => 0;

# gtk_tree_model_iter_n_children
#
sub ITER_N_CHILDREN {
  my ($self, $iter) = @_;
  ### ListModelConcat iter_n_children
  if (defined $iter) {
    return 0;  # nothing under rows
  } else {
    return _total_length($self);
  }
}

# gtk_tree_model_iter_children
#
sub ITER_CHILDREN {
  # my ($self, $iter) = @_;
  ### ListModelConcat iter_children
  push @_, 0;
  goto &ITER_NTH_CHILD;
}

# gtk_tree_model_iter_nth_child
#
sub ITER_NTH_CHILD {
  my ($self, $iter, $n) = @_;
  ### ListModelConcat iter_nth_child: $n
  if (defined $iter) {
    return undef;
  }
  if ($n < _total_length($self)) {
    return _index_to_iter ($self, $n);
  } else {
    return undef;
  }
}

# gtk_tree_model_iter_parent
# my ($self, $iter) = @_;
# no parent rows in a list-only
#
use constant ITER_PARENT => undef;


#------------------------------------------------------------------------------
# iter conversions

# return ($model, $subiter, $mnum)
sub convert_iter_to_child_iter {
  my ($self, $iterobj) = @_;
  return _index_to_subiter ($self, _iterobj_to_index($self,$iterobj));
}

sub convert_child_iter_to_iter {
  my ($self, $model, $subiter) = @_;
  my $models = $self->{'models'};
  for (my $mnum = 0; $mnum < @$models; $mnum++) {
    if ($models->[$mnum] == $model) {
      return $self->convert_childnum_iter_to_iter ($mnum, $subiter);
    }
  }
  croak "ListModelConcat does not contain '$model'";
}
sub convert_childnum_iter_to_iter {
  my ($self, $mnum, $subiter) = @_;
  my $models = $self->{'models'};
  my $model = $models->[$mnum] || croak "No model number $mnum";
  my $subpath = $model->get_path ($subiter);
  my ($subindex) = $subpath->get_indices;
  my $positions = _model_positions($self);
  return _index_to_iterobj ($self, $positions->[$mnum] + $subindex);
}


#------------------------------------------------------------------------------
# our iters

sub _index_to_iter {
  my ($self, $index) = @_;
  return [ $self->{'stamp'}, $index, undef, undef ];
}
sub _iter_to_index {
  my ($self, $iter) = @_;
  if (! defined $iter) { return undef; }
  if ($iter->[0] != $self->{'stamp'}) {
    croak "iter is not for this ", ref($self),
      " (stamp ", $iter->[0], " want ", $self->{'stamp'}, ")";
  }
  return $iter->[1];
}

sub _iterobj_to_index {
  my ($self, $iterobj) = @_;
  if (! defined $iterobj) { croak 'ListModelConcat: iter cannot be undef'; }
  return _iter_to_index ($self, $iterobj->to_arrayref ($self->{'stamp'}));
}
sub _index_to_iterobj {
  my ($self, $index) = @_;
  return Gtk2::TreeIter->new_from_arrayref (_index_to_iter ($self, $index));
}


#------------------------------------------------------------------------------
# sub-model lookups

sub _model_positions {
  my ($self) = @_;
  return ($self->{'positions'} ||= do {
    my $models = $self->{'models'};
    my $pos = 0;
    return ($self->{'positions'}
            = [ 0, map { $pos += $_->iter_n_children(undef) } @$models ]);
  });
}
sub _model_offset {
  my ($self, $mnum) = @_;
  my $positions = _model_positions ($self);
  return $positions->[$mnum];
}
sub _total_length {
  my ($self) = @_;
  return _model_positions($self)->[-1];
}

# return ($model, $subiter, $mnum)
sub _index_to_subiter {
  my ($self, $index) = @_;
  my ($model, $subindex, $mnum) = _index_to_subindex ($self, $index);
  return ($model, $model->iter_nth_child(undef,$subindex), $mnum);
}

# return ($model, $subindex, $mnum)
sub _index_to_subindex {
  my ($self, $index) = @_;
  if ($index < 0) {
    croak 'ListModelConcat: invalid iter (negative index)';
  }
  my $models = $self->{'models'};
  my $positions = _model_positions ($self);
  if ($index >= $positions->[-1]) {
    croak 'ListModelConcat: invalid iter (index too big)';
  }
  for (my $i = $#$positions - 1; $i >= 0; $i--) {
    if ($positions->[$i] <= $index) {
      return ($models->[$i], $index - $positions->[$i], $i);
    }
  }
  croak 'ListModelConcat: invalid iter (no sub-models at all now)';
}

# sub _bsearch {
#   my ($aref, $target) = @_;
#   my $lo = 0;
#   my $hi = @$aref;
#   for (;;) {
#     my $mid = int (($lo + $hi) / 2);
#     if ($mid == $lo) { return $mid; }
# 
#     my $elem = $aref->[$mid];
#     if ($elem > $target) {
#       $hi = $mid;
#     } elsif ($elem < $target) {
#       $lo = $mid+1;
#     } else {
#       return $mid;
#     }
#   }
# }

sub _no_submodels {
  my ($operation) = @_;
  croak "ListModelConcat: no sub-models to $operation";
}


#------------------------------------------------------------------------------

# 'row-changed' on the submodels
# called multiple times if a model is present multiple times
#
sub _do_row_changed {
  my ($model, $subpath, $subiter, $userdata) = @_;
  ### ListModelConcat row_changed handler
  my ($self, $mnum)= @$userdata;
  if (! $self) { return; }
  if ($self->{'suppress_signals'}) { return; }
  if ($subpath->get_depth != 1) { return; }  # ignore non-toplevel

  my ($subindex) = $subpath->get_indices;
  my $index = $subindex + _model_offset($self,$mnum);
  my $path = Gtk2::TreePath->new_from_indices ($index);
  my $iterobj = _index_to_iterobj ($self, $index);
  $self->row_changed ($path, $iterobj);
}

# 'row-inserted' on the submodels
# called multiple times if a model is present multiple times, going from
# first to last, which should present the positions correctly to the
# listeners, even if the data has all the inserts already done
#
sub _do_row_inserted {
  my ($model, $subpath, $subiter, $userdata) = @_;
  ### ListModelConcat row_inserted handler
  my ($self, $mnum) = @$userdata;
  if (! $self) { return; }
  if ($self->{'suppress_signals'}) { return; }
  if ($subpath->get_depth != 1) { return; }  # ignore non-toplevel

  if (my $positions = $self->{'positions'}) {
    foreach my $i ($mnum+1 .. $#$positions) {
      $positions->[$i] ++;
    }
  }

  my ($subindex) = $subpath->get_indices;
  my $index = $subindex + _model_offset($self,$mnum);
  my $path = Gtk2::TreePath->new_from_indices ($index);
  my $iterobj = _index_to_iterobj ($self, $index);
  $self->row_inserted ($path, $iterobj);
}

# 'row-deleted' on the submodels
# called multiple times if a model is present multiple times, going from
# first to last, which should present the positions correctly to the
# listeners, even if the data has all the inserts already done
#
sub _do_row_deleted {
  my ($model, $subpath, $userdata) = @_;
  my ($self, $mnum) = @$userdata;
  ### ListModelConcat row_deleted handler
  if (! $self) { return; }
  if ($self->{'suppress_signals'}) { return; }
  if ($subpath->get_depth != 1) { return; }  # ignore non-toplevel

  if (my $positions = $self->{'positions'}) {
    foreach my $i ($mnum+1 .. $#$positions) {
      $positions->[$i] --;
    }
  }

  my ($subindex) = $subpath->get_indices;
  my $index = $subindex + _model_offset($self,$mnum);
  my $path = Gtk2::TreePath->new_from_indices ($index);
  $self->row_deleted ($path);
}

# 'rows-reordered' on the submodels
# called just once if a model is present multiple times, and a single
# rows-reordered with all changes generated here for listeners
#
sub _do_rows_reordered {
  my ($model, $path, $iter, $subaref, $userdata) = @_;
  my ($self, $mnum) = @$userdata;
  if (! $self) { return; }
  ### ListModelConcat rows_reordered handler
  if ($self->{'suppress_signals'}) { return; }
  if ($path->get_depth != 0) { return; } # ignore non-toplevel

  # array[newpos] = oldpos, ie. the array elem says where the row used to be
  # before the reordering.  $subaref says that of its sub-model portion of
  # @array.
  #
  my @array = (0 .. _total_length($self) - 1);
  my $models = $self->{'models'};
  my $positions = _model_positions($self);
  foreach my $i (0 .. $#$models) {
    if ($models->[$i] == $model) {
      my $offset = $positions->[$i];
      foreach my $i (0 .. $#$subaref) {
        $array[$offset + $i] = $subaref->[$i] + $offset;
      }
    }
  }
  $self->rows_reordered ($path, undef, @array);
}


#------------------------------------------------------------------------------
# Gtk2::ListStore compatible methods


# gtk_list_store_append
# new row at end, return iter pointing to it
sub append {
  my ($self) = @_;
  my $model = $self->{'models'}->[-1] or _no_submodels('append');
  return $model->append
    && _index_to_iterobj ($self, _total_length($self) - 1);
}

# gtk_list_store_prepend
# new row at start, return iter pointing to it
sub prepend {
  my ($self) = @_;
  my $model = $self->{'models'}->[0] or _no_submodels('prepend');
  return $model->prepend
    && _index_to_iterobj ($self, 0);
}

# The sub-models should generate row-deleted signals like Gtk2::ListModel
# does.  Normally it's just repeated delete of item 0, though if a model
# appears more than once in the Concat the copies further on are reported
# too, which leads to a strange, though correct, sequence.
sub clear {
  my ($self) = @_;
  foreach my $model (@{$self->{'models'}}) {
    $model->clear;
  }
  # new stamp to invalidate all existing iters like GtkListStore does
  Gtk2::Ex::TreeModel::ImplBits::random_stamp ($self);
}

sub set_column_types {
  my ($self, @types) = @_;
  foreach my $model (@{$self->{'models'}}) {
    $model->set_column_types (@types);
  }
}

sub set {
  my $self = shift;
  my $iterobj = shift;
  my ($model, $subiter) = $self->convert_iter_to_child_iter ($iterobj);
  $model->set ($subiter, @_);
}
sub set_value {
  my $self = shift;
  my $iterobj = shift;
  my ($model, $subiter) = $self->convert_iter_to_child_iter ($iterobj);
  $model->set_value ($subiter, @_);
}


# insert before $index, or append if $index past last existing row
# insert_with_values the same, taking col=>value pairs
sub insert {
  unshift @_, 'insert';
  goto &_insert;
}
sub insert_with_values {
  unshift @_, 'insert_with_values';
  goto &_insert;
}
sub _insert {
  my ($method, $self, $index, @args) = @_;
  my ($model, $subindex, $mnum);
  my $total_length = _total_length ($self);
  if ($index >= $total_length) {
    $index = $total_length; # in case wildly past end
    my $models = $self->{'models'};
    $model = $self->{'models'}->[-1]
      or _no_submodels($method);
    $mnum = $#$models;
    $subindex = $index; # past end
  } else {
    ($model, $subindex, $mnum) = _index_to_subindex ($self, $index);
  }
  my $subiter = $model->$method ($subindex, @args);
  return _subiter_to_iterobj ($self, $model, $subiter, $mnum);
}

# insert after $iterobj, or at beginning if $iterobj undef (yes, the beginning)
sub insert_after {
  unshift @_, 'insert_after', 0;
  goto &_insert_beforeafter;
}
sub insert_before {
  unshift @_, 'insert_before', -1;
  goto &_insert_beforeafter;
}
sub _insert_beforeafter {
  my ($method, $mnum, $self, $iterobj) = @_;
  my ($model, $subiter);
  if ($iterobj) {
    ($model, $subiter, $mnum) = $self->convert_iter_to_child_iter ($iterobj);
  } else {
    my $models = $self->{'models'};
    $model = $models->[$mnum] or _no_submodels($method);
    if ($mnum) { $mnum = $#$models; }
    $subiter = undef;
  }
  $subiter = $model->$method ($subiter);
  return _subiter_to_iterobj ($self, $model, $subiter, $mnum);
}

sub _subiter_to_iterobj {
  my ($self, $model, $subiter, $mnum) = @_;
  my $positions = _model_positions ($self);
  my ($subindex) = $model->get_path($subiter)->get_indices;
  my $index = $positions->[$mnum] + $subindex;
  return _index_to_iterobj ($self, $index);
}

sub iter_is_valid {
  my ($self, $iter) = @_;
  my $a = eval { $iter->to_arrayref($self->{'stamp'}) };
  return ($a && $a->[1] < _total_length($self));
}

# gtk_list_store_move_after
# $dst_iterobj undef means the start (yes, the start) of the list
sub move_after {
  my ($self, $src_iterobj, $dst_iterobj) = @_;
  my $src_index = _iterobj_to_index ($self, $src_iterobj);
  my ($src_model, $src_subiter) = _index_to_subiter ($self, $src_index);

  my ($dst_index, $dst_model, $dst_subindex);
  if (defined $dst_iterobj) {
    $dst_index = _iterobj_to_index ($self, $dst_iterobj);
    ($dst_model, $dst_subindex) = _index_to_subindex ($self, $dst_index);
  } else {
    $dst_index = -1;
    $dst_model = $self->{'models'}->[0] or _no_submodels('insert_after');
    $dst_subindex = 0;
  }

  if ($src_model == $dst_model) {
    my $dst_subiter
      = $dst_iterobj && $dst_model->iter_nth_child (undef, $dst_subindex);
    $src_model->move_after ($src_subiter, $dst_subiter);

  } else {
    my $rem = _need_method ($src_model, 'remove');
    my $ins = _need_method ($dst_model, 'insert_with_values');
    my @row = _treemodel_extract_row ($src_model, $src_subiter);
    my $dst_ins_subindex = ($dst_iterobj ? $dst_subindex + 1 : 0);

    { local $self->{'suppress_signals'} = 1;
      $ins->($dst_model, $dst_ins_subindex, @row);
      $rem->($src_model, $src_subiter);
    }
    delete $self->{'positions'};  # recalculate

    _move_after_reorder ($self, $src_index, $dst_index);
  }
}

# Emit a 'rows-reordered' signal for a move of row $src_index to after
# $dst_index.  $dst_index can be -1 for the very start.
sub _move_after_reorder {
  my ($self, $src_index, $dst_index) = @_;
  my $path = Gtk2::TreePath->new;
  my $last_index = _total_length($self) - 1;

  if ($dst_index >= $src_index) {
    # upwards move eg. 0 to after 4 becomes 1,2,3,4,0
    $self->rows_reordered
      ($path, undef,
       0 .. $src_index-1,            # before, unchanged
       $src_index+1 .. $dst_index,   # shifted
       $src_index,                   # moved row
       $dst_index+1 .. $last_index); # after, unchanged

  } else {
    # downwards move eg. 4 to after 0 becomes 0,4,1,2,3
    $self->rows_reordered
      ($path, undef,
       0 .. $dst_index,              # before, unchanged
       $src_index,                   # moved row
       $dst_index+1 .. $src_index-1, # shifted
       $src_index+1 .. $last_index); # after, unchanged
  }
}

# gtk_list_store_move_before
# $dst_iterobj undef means the end (yes, the end) of the list
sub move_before {
  my ($self, $src_iterobj, $dst_iterobj) = @_;
  my $src_index = _iterobj_to_index ($self, $src_iterobj);
  my ($src_model, $src_subiter) = _index_to_subiter ($self, $src_index);

  my ($dst_index, $dst_model, $dst_subindex);
  if ($dst_iterobj) {
    $dst_index = _iterobj_to_index ($self, $dst_iterobj);
    ($dst_model, $dst_subindex) = _index_to_subindex ($self, $dst_index);
  } else {
    $dst_index = _total_length($self);
    $dst_model = $self->{'models'}->[-1] or _no_submodels('insert_after');
    $dst_subindex = $dst_index;
  }

  if ($src_model == $dst_model) {
    my $dst_subiter
      = $dst_iterobj && $dst_model->iter_nth_child (undef, $dst_subindex);
    $src_model->move_before ($src_subiter, $dst_subiter);

  } else {
    my $rem = _need_method ($src_model, 'remove');
    my $ins = _need_method ($dst_model, 'insert_with_values');
    my @row = _treemodel_extract_row ($src_model, $src_subiter);

    { local $self->{'suppress_signals'} = 1;
      $ins->($dst_model, $dst_subindex, @row);
      $rem->($src_model, $src_subiter);
    }
    delete $self->{'positions'};  # recalculate

    _move_after_reorder ($self, $src_index, $dst_index-1);
  }
}

sub _need_method {
  my ($model, $name) = @_;
  return ($model->can($name)
          || croak "ListModelConcat: submodel doesn't support '$name'");
}

# gtk_list_store_remove
#
# Usually deleting a row just means our $index in $iterobj should stay the
# same, only with a check it wasn't the very last row deleted.  But if the
# target $model appears more than once then deleting in its second or
# subsequent appearance will delete a row before and $index in $iterobj must
# be moved down.  For that reason get a fresh @$positions after
# $model->remove.
#
sub remove {
  my ($self, $iterobj) = @_;
  if (! defined $iterobj) { croak 'Cannot remove iter "undef"'; }
  my $index = _iterobj_to_index ($self, $iterobj);
  my ($model, $subiter, $mnum) = _index_to_subiter ($self, $index);

  my $submore = $model->remove ($subiter);
  my $positions = _model_positions($self);

  if ($submore) {
    # $subiter has been updated to the next row, make an iter from it
    my $subpath = $model->get_path ($subiter);
    my ($subindex) = $subpath->get_indices;
    $index = $positions->[$mnum] + $subindex;

  } else {
    # nothing more in this $model, so we're at the start of the following
    # model, unless it and all following are empty
    if (defined ($index = $positions->[$mnum+1])) {
      if ($index >= _total_length($self)) {
        $index = undef;
      }
    }
  }

  if (defined $index) {
    $iterobj->set ([ $self->{'stamp'}, $index, undef, undef ]);
    return 1; # more rows
  } else {
    # zap iter so it's not accidentally re-used (same as GtkListStore does)
    $iterobj->set ([ 0, 0, undef, undef ]);
    return 0; # no more rows
  }
}

# gtk_list_store_reorder
#
sub reorder {
  my ($self, @neworder) = @_;

  my $len = _total_length($self);
  if (@neworder != $len) {
    croak 'ListModelConcat: new order array wrong length';
  }

  my @row;
  foreach my $newpos (0 .. $#neworder) {
    my $oldpos = $neworder[$newpos];
    if ($oldpos < 0 || $oldpos >= $len) {
      croak "ListModelConcat: invalid old position in order array: $oldpos";
    }
    if ($oldpos != $newpos) {
      my ($model, $subiter) = _index_to_subiter ($self, $oldpos);
      $row[$oldpos] = [ _treemodel_extract_row ($model, $subiter) ];
    }
  }
  { local $self->{'suppress_signals'} = 1;
    foreach my $newpos (0 .. $#neworder) {
      my $oldpos = $neworder[$newpos];
      if ($oldpos != $newpos) {
        my ($model, $subiter) = _index_to_subiter ($self, $newpos);
        $model->set ($subiter, @{$row[$oldpos]});
      }
    }
  }
  $self->rows_reordered (Gtk2::TreePath->new, undef, @neworder);
}

sub swap {
  my ($self, $iterobj_a, $iterobj_b) = @_;
  my $index_a = _iterobj_to_index ($self, $iterobj_a);
  my $index_b = _iterobj_to_index ($self, $iterobj_b);

  my ($model_a, $subiter_a) = _index_to_subiter ($self, $index_a);
  my ($model_b, $subiter_b) = _index_to_subiter ($self, $index_b);
  if ($model_a == $model_b) {
    $model_a->swap ($subiter_a, $subiter_b);

  } else {
    my @row_a = _treemodel_extract_row ($model_a, $subiter_a);
    my @row_b = _treemodel_extract_row ($model_b, $subiter_b);
    { local $self->{'suppress_signals'} = 1;
      $model_a->set ($subiter_a, @row_b);
      $model_b->set ($subiter_b, @row_a); }

    my @array = (0 .. _total_length($self) - 1);
    $array[$index_a] = $index_b;   # $array[newpos] == oldpos
    $array[$index_b] = $index_a;
    $self->rows_reordered (Gtk2::TreePath->new, undef, @array);
  }
}

# return a list of values (0, 'col0', 1, 'col1', ...) which is the column
# number and its contents
sub _treemodel_extract_row {
  my ($model, $iter) = @_;
  my @row = $model->get($iter);
  return map {; ($_,$row[$_]) } 0 .. $#row;
}

#------------------------------------------------------------------------------
# drag source Gtk2::TreeDragSource

# gtk_tree_drag_source_row_draggable ($self, $path)
#
sub ROW_DRAGGABLE {
  # my ($self, $path) = @_;
  unshift @_, 'row_draggable';
  goto &_drag_source;
}

# gtk_tree_drag_source_drag_data_delete ($self, $path)
#
sub DRAG_DATA_DELETE {
  # my ($self, $path) = @_;
  unshift @_, 'drag_data_delete';
  goto &_drag_source;
}

# gtk_tree_drag_source_drag_data_get ($self, $path, $sel)
#
sub DRAG_DATA_GET {
  # my ($self, $path, $sel) = @_;
  unshift @_, 'drag_data_get';
  goto &_drag_source;
}

sub _drag_source {
  my ($method, $self, $path, @sel_arg) = @_;
  ### ListModelConcat: "\U$method\E path=".$path->to_string

  if ($path->get_depth != 1) {
    ### no, not a toplevel row
    return 0;
  }
  my ($index) = $path->get_indices;
  my ($model, $subindex) = _index_to_subindex ($self, $index);

  if (! $model->isa('Gtk2::TreeDragSource')) {
    ### no, submodel not a TreeDragSource
    return 0;
  }
  my $subpath = Gtk2::TreePath->new_from_indices ($subindex);
  ### submodel row_draggable subpath: $subpath->to_string
  my $ret = $model->$method ($subpath, @sel_arg);
  ### submodel result: $ret
  return $ret;
}

#------------------------------------------------------------------------------
# drag destination Gtk2::TreeDragDest

# gtk_tree_drag_dest_row_drop_possible
# gtk_tree_drag_dest_drag_data_received
#
sub ROW_DROP_POSSIBLE {
  push @_, 'row_drop_possible';
  goto &_drag_dest;
}
sub DRAG_DATA_RECEIVED {
  push @_, 'drag_data_received';
  goto &_drag_dest;
}
sub _drag_dest {
  my ($self, $dst_path, $sel, $method) = @_;
  ### ListModelConcat: "\U$method\E, to path=".$dst_path->to_string
  ### type: $sel->type->name
  ### sel row: $sel->type->name eq 'GTK_TREE_MODEL_ROW' && do { my ($src_model, $src_path) = $sel->get_row_drag_data; "  src_model=$src_model src_path=".$src_path->to_string }

  if ($dst_path->get_depth != 1) {
    ### no, not a toplevel row
    return 0;
  }
  my ($dst_index) = $dst_path->get_indices;
  my ($dst_submodel, $dst_subindex)
    = _index_to_subindex_post ($self, $dst_index);

  if (! $dst_submodel->isa('Gtk2::TreeDragDest')) {
    ### no, submodel not a TreeDragDest
    return 0;
  }
  my $dst_subpath = Gtk2::TreePath->new_from_indices ($dst_subindex);
  if (! $dst_submodel->$method ($dst_subpath, $sel)) {
    ### no, submodel $method() false
    return 0;
  }
  ### yes from submodel
  return 1;
}

# return ($model, $subindex), and allowing a $index which is past the end of
# $self to likewise give a subindex beyond the end of the last submodel
#
sub _index_to_subindex_post {
  my ($self, $index) = @_;
  my $positions = _model_positions ($self);
  if ($index < $positions->[-1]) {
    return _index_to_subindex ($self, $index);
  }
  my $model = $self->{'models'}->[-1]
    or return (undef, undef);  # no models at all
  return ($model, $index - $positions->[-2]);
}

1;
__END__

=for stopwords TreeModels Concat eg ListStores ListModelConcat Gtk2-Ex-ListModelConcat TreeDragSource TreeDragDest submodels submodel ie Arrayref Eg ListStore Iter iters versa TreeModelFilter iter arrayref func TreeModel TreeModelFilters Ryde Gtk2-Perl

=head1 NAME

Gtk2::Ex::ListModelConcat -- concatenated list models

=for test_synopsis my ($m1, $m2);

=head1 SYNOPSIS

 use Gtk2::Ex::ListModelConcat;
 my $model = Gtk2::Ex::ListModelConcat->new (models => [$m1,$m2]);

=head1 OBJECT HIERARCHY

C<Gtk2::Ex::ListModelConcat> is a subclass of C<Glib::Object>.

    Glib::Object
      Gtk2::Ex::ListModelConcat

and implements the interfaces

    Gtk2::TreeModel
    Gtk2::TreeDragSource
    Gtk2::TreeDragDest

=head1 DESCRIPTION

C<Gtk2::Ex::ListModelConcat> presents a set of list type TreeModels
concatenated together as a single list.  A Concat doesn't hold any data
itself, it just presents the sub-models' content.  C<Gtk2::ListStore>
objects are suitable as the sub-models, but any similar list-type model can
be used.

                    +--------+
            / row 0 | apple  | row 0 \
           /        +--------+        \
           |  row 1 | orange | row 1  | first child
           |        +--------+        /
           |  row 2 | lemon  | row 2 /
           |        +--------+
    Concat |  row 3 | potato | row 0 \
           |        +--------+        \
           |  row 4 | carrot | row 1  |
           |        +--------+        | second child
           |  row 5 | squash | row 2  |
           \        +--------+        /
            \ row 6 | onion  | row 3 /
                    +--------+


Changes in the sub-models are reported up through the Concat with the usual
C<row-changed> etc signals.  Conversely change methods are implemented by
the Concat in the style of C<Gtk2::ListStore> and if the sub-models have
those functions too (eg. if they're ListStores) then changes on the Concat
are applied down to the sub-models.

The sub-models should have the same number of columns and the same column
types (or compatible types), though currently ListModelConcat doesn't try to
enforce that.  It works to put one Concat inside another, except of course
it cannot be inside itself (directly or indirectly).

=head1 DRAG AND DROP

ListModelConcat implements TreeDragSource and TreeDragDest, allowing rows to
be moved by dragging in C<Gtk2::TreeView> or similar.  The actual operations
are delegated to the submodels, so a row can be dragged if the originating
submodel is a TreeDragSource and a location is a drop point if the submodel
there is a TreeDragDest.

It's worth noting the standard C<Gtk2::ListStore> models only accept drops
of their own rows, ie. a re-ordering, not movement of rows between different
models.  This is reasonable since different models might have different
natures, but you might want to subclass or use a wrapper to make a more
liberal policy between compatible models.

=head1 PROPERTIES

=over 4

=item C<models> (array reference, default empty C<[]>)

Arrayref of sub-models to present.  The sub-models can be any object
implementing the C<Gtk2::TreeModel> interface.  They should be C<list-only>
type, but currently ListModelConcat doesn't enforce that.

Currently when the C<models> property is changed there's no C<row-inserted>
/ C<row-deleted> etc signals emitted by the Concat to announce the new or
altered data presented.  Perhaps this will change.  The disadvantage would
be that adding or removing a big model could generate thousands of fairly
pointless signals.  The suggestion is to treat C<models> as if it were
"construct-only" and make a new Concat for a new set of models.

=back

=head1 FUNCTIONS

=head2 Creation

=over 4

=item C<< $concat = Gtk2::Ex::ListModelConcat->new (key=>value,...) >>

Create and return a new Concat object.  Optional key/value pairs set initial
properties per C<< Glib::Object->new >>.  Eg.

 my $concat = Gtk2::Ex::ListModelConcat->new (models => [$m1,$m2]);

=back

=head2 ListStore Methods

The following functions follow the style of C<Gtk2::ListStore> and they call
down to corresponding functions in the sub-models.  Those sub-models don't
have to be C<Gtk2::ListStore> objects, they can be some other class
implementing the same methods.

=over 4

=item C<< $concat->clear >>

=item C<< $concat->set_column_types >>

These are applied to all sub-models, so C<clear> clears all the models or
C<set_column_types> sets the types in all the models.

In the current implementation Concat doesn't keep track of column types
itself, but asks the sub-models when required (using the first sub-model,
currently).

=item C<< $iter = $concat->append >>

=item C<< $iter = $concat->insert ($pos) >>

=item C<< $iter = $concat->insert_with_values ($pos, $col,$val, ...) >>

=item C<< $iter = $concat->insert_after ($iter) >>

=item C<< $iter = $concat->insert_before ($iter) >>

=item C<< bool = $concat->iter_is_valid ($iter) >>

=item C<< $concat->move_after ($iter, $iter_from, $iter_to) >>

=item C<< $concat->move_before ($iter, $iter_from, $iter_to) >>

=item C<< $iter = $concat->prepend >>

=item C<< bool = $concat->remove ($iter) >>

=item C<< $concat->reorder (@neworder) >>

=item C<< $concat->swap ($iter_a, $iter_b) >>

=item C<< $concat->set ($iter, $col,$val, ...) >>

=item C<< $concat->set_value ($iter, $col, $val) >>

These are per the C<Gtk2::ListStore> methods.

Note C<set> overrides the C<set> from C<Glib::Object> which normally sets
object properties.  You can use its C<set_property> name instead.

    $model->set_property ('propname' => $value);

As of Gtk2-Perl 1.200 C<set_value> in C<Gtk2::ListStore> is actually an
alias for C<set> and so accepts multiple C<$col,$val> pairs.
ListModelConcat passes all C<set_value> arguments through to the sub-model
C<set_value> (after converting the C<$iter>), so it's up to it what should
work.

=back

=head2 Iter Conversions

The following functions convert Concat iters to iters on the child model, or
vice versa.  They're similar to what TreeModelFilter offers (see
L<Gtk2::TreeModelFilter>), except that a particular child model is returned
and must be specified since a Concat can have multiple children.

=over 4

=item C<< ($childmodel, $childiter, $childnum) = $concat->convert_iter_to_child_iter ($iter) >>

Convert a ListModelConcat iter to an iter on the child model corresponding
to that row.

The return includes the C<$childnum> which is an index into the C<models>
property arrayref.  If a child model appears more than once in the models
then this identifies which occurrence the C<$iter> refers to.  Often this is
of no interest and can be ignored.

    my ($childmodel, $childiter)
      = $concat->convert_iter_to_child_iter ($iter);
    $childmodel->something($childiter) ...

=item C<< $iter = $concat->convert_child_iter_to_iter ($childmodel, $childiter) >>

=item C<< $iter = $concat->convert_childnum_iter_to_iter ($childnum, $childiter) >>

Convert an iter on one of the child models to an iter on the
ListModelConcat.

The C<childnum> func takes an index into the C<models> list, counting from 0
for the first model.  If you've got a child model appearing more than once
then this lets you identify which one you mean.  The plain C<$childmodel>
func gives the first occurrence of that model.

=back

=head1 SIGNALS

The TreeModel interface implemented by ListModelConcat provides the
following usual signals

    row-changed    ($concat, $path, $iter, $userdata)
    row-inserted   ($concat, $path, $iter, $userdata)
    row-deleted    ($concat, $path, $userdata)
    rows-reordered ($concat, $path, $iter, $arrayref, $userdata)

Because ListModelConcat is C<list-only>, the path to C<row-changed>,
C<row-inserted> and C<row-deleted> is always depth 1, and the path to
C<rows-reordered> is always depth 0 and the iter there always C<undef>.

When a change occurs in a sub-model the corresponding signal is reported up
through Concat.  The path and iter are of course reported by the Concat in
its "concatenated" coordinates and iters, not the sub-model's.

=head1 BUGS

C<ref_node> and C<unref_node> are no-ops.  The intention is to apply them
down on the sub-models, but hopefully without needing lots of bookkeeping in
the Concat as to what's currently reffed.

It mostly works to have a sub-model appear more than once in a Concat.  The
only real problem is with the C<row-deleted> and C<row-inserted> signals.
They're emitted on the Concat the right number of times, but the multiple
inserts/deletes are all present in the data as of the first emit, which
could confuse handler code.  (Perhaps some sort of temporary index mapping
could make the changes seem one-at-a-time, except the deleted row contents
have already gone ...)

What does work fine though is to have multiple TreeModelFilters (or similar)
selecting different parts of a single underlying model.  As long as a given
row only appears once it doesn't matter where its ultimate storage location
is.

=head1 SEE ALSO

L<Gtk2::TreeModel>, L<Gtk2::TreeDragSource>, L<Gtk2::TreeDragDest>,
L<Gtk2::ListStore>, L<Glib::Object>

=head1 HOME PAGE

L<http://user42.tuxfamily.org/gtk2-ex-listmodelconcat/>

=head1 COPYRIGHT

Copyright 2008, 2009, 2010 Kevin Ryde

Gtk2-Ex-ListModelConcat 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 3, or (at your option) any
later version.

Gtk2-Ex-ListModelConcat 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
Gtk2-Ex-ListModelConcat.  If not, see L<http://www.gnu.org/licenses/>.

=cut
