# 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 . 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 = 10; use Glib::Object::Subclass 'Glib::Object', interfaces => [ 'Gtk2::TreeModel', 'Gtk2::TreeDragSource', 'Gtk2::TreeDragDest', # Gtk2::Buildable new in Gtk 2.12, omit if not available Gtk2::Widget->isa('Gtk2::Buildable') ? ('Gtk2::Buildable') : () ], properties => [ Glib::ParamSpec->scalar ('models', 'models', 'Arrayref of list model objects to concatenate.', Glib::G_PARAM_READWRITE), Glib::ParamSpec->object ('append-model', 'append-model', 'Append a model to the concatenation.', 'Gtk2::TreeModel', ['writable']), ]; sub INIT_INSTANCE { my ($self) = @_; ### ListModelConcat INIT_INSTANCE() Gtk2::Ex::TreeModel::ImplBits::random_stamp ($self); $self->{'models'} = []; } sub SET_PROPERTY { my ($self, $pspec, $newval) = @_; ### ListModelConcat SET_PROPERTY(): $pspec->get_name ### $newval my $pname = $pspec->get_name; if ($pname eq 'append_model') { $self->append_model ($newval); return; } if ($pname eq 'models') { foreach my $model (@$newval) { (Scalar::Util::blessed($model) && $model->isa('Gtk2::TreeModel')) or croak 'ListModelConcat: sub-model is not a Gtk2::TreeModel'; } 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); } ### models now: $self->{'models'} } else { $self->{$pname} = $newval; # per default GET_PROPERTY } } sub append_model { my $self = shift; ### ListModelConcat append_model(): @_ $self->set_property (models => [ @{$self->{'models'}}, @_ ]); } #------------------------------------------------------------------------------ # TreeModel interface # 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"; } #------------------------------------------------------------------------------ # sub-model signals # '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; } #------------------------------------------------------------------------------ # Gtk2::TreeDragSource interface, drag source # 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; } #------------------------------------------------------------------------------ # Gtk2::TreeDragDest interface, drag destination # 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]); } #------------------------------------------------------------------------------ # Gtk2::Buildable interface sub ADD_CHILD { my ($self, $builder, $child, $type) = @_; ### ListModelConcat ADD_CHILD(): @_ $self->append_model ($child); } 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 is a subclass of C. Glib::Object Gtk2::Ex::ListModelConcat and implements the interfaces Gtk2::TreeModel Gtk2::TreeDragSource Gtk2::TreeDragDest =head1 DESCRIPTION C 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 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 etc signals. Conversely change methods are implemented by the Concat in the style of C 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 C and C interfaces, allowing rows to be moved by dragging in C 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 its submodel is a TreeDragDest. It's worth noting the standard C 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 for a more liberal policy among compatible models. =head1 PROPERTIES =over 4 =item C (array reference, default empty C<[]>) Arrayref of sub-models to present. The sub-models can be any object implementing the C interface. They should be C type, but currently ListModelConcat doesn't enforce that. Currently when the C property is changed there's no C / C 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 as if it were "construct-only" and make a new Concat for a new set of models. =item C (C, write-only) A write-only pseudo-property which appends a model to the Concat, per the C method below. This can be used to add models from a C (see L below). =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]); =item C<< $concat->append_model ($model, ...) >> Append each given C<$model> to those already in C<$concat>. See L above for an equivalent C property and notes on signal emission. =back =head2 ListStore Methods The following functions follow the style of C and they call down to corresponding functions in the sub-models. Those sub-models don't have to be C 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 clears all the models or C 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 methods. Note C overrides the C from C which normally sets object properties. You can use its C name instead. $model->set_property ('propname' => $value); As of Gtk2-Perl 1.200 C in C is actually an alias for C and so accepts multiple C<$col,$val> pairs. ListModelConcat passes all C arguments through to the sub-model C (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), 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 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 func takes an index into the C 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, the path to C, C and C is always depth 1, and the path to C is always depth 0 and the iter there always C. When a change occurs in a sub-model the corresponding signal is reported up through Concat. The path and iter are of course reported up in the "concatenated" coordinates and iters, not the sub-model's. =head1 BUILDABLE ListModelConcat implements the C interface of Gtk 2.12 and up, allowing C to construct a Concat with child sub-model objects. Sub-models can be added either through the C pseudo-property for separately created model objects, mysubmodel-one mysubmodel-two Or with C<< >> elements constructing sub-model objects at that point, 123 The two styles are just a matter of whether you prefer to create the sub-models at the top-level and add to a Concat by name, or make them in the concat and refer to them elsewhere by name. It's not a good idea to mix C<< >> and C since the order among the different settings may not be preserved. As of Gtk 2.20 the builder works by adding all C<< >> objects and then setting properties a bit later, or something like that, so C<< >> objects end up before C even if written the other way around. See F and F in the ListModelConcat sources for complete sample programs. =head1 BUGS C and C 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 and C 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 is. =head1 SEE ALSO L, L, L, L, L =head1 HOME PAGE L =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. =cut