# Copyright 2008, 2009 Kevin Ryde # This file is part of Chart. # # Chart 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. # # Chart 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 Chart. If not, see . package Gtk2::Ex::TreeModelConcat; use strict; use warnings; use Gtk2; use Carp; use Glib::Object::Subclass 'Glib::Object', interfaces => [ Gtk2::TreeModel:: ], properties => [ Glib::ParamSpec->scalar ('models', 'models', 'Arrayref of Gtk2::TreeModel objects to concatenate.', Glib::G_PARAM_READWRITE) ]; use constant DEBUG => 0; sub INIT_INSTANCE { my ($self) = @_; $self->{'models'} = []; require Tie::RefHash; my %mhash; tie %mhash, 'Tie::RefHash'; $self->{'mhash'} = \%mhash; my %offsets; tie %offsets, 'Tie::RefHash'; $self->{'offsets'} = \%offsets; } sub SET_PROPERTY { my ($self, $pspec, $newval) = @_; my $pname = $pspec->get_name; $self->{$pname} = $newval; # per default GET_PROPERTY if (DEBUG) { print "TreeModelConcat set $pname\n"; } if ($pname eq 'models') { my $models = $newval; $self->{'flags'} = undef; $self->{'offsets'} = (); %{$self->{'mhash'}} = (map {$_ => {}} @$models); } } # gtk_tree_model_get_flags # sub GET_FLAGS { my ($self) = @_; return ($self->{'flags'} ||= do { my $flags = []; my $models = $self->{'models'}; if (@$models) { $flags = [ 'list-only' ]; foreach my $model (@$models) { if (! ($model->get_flags & 'list-only')) { $flags = []; last; } } } $flags; }); } # gtk_tree_model_get_n_columns # sub GET_N_COLUMNS { my ($self) = @_; my $model = $self->{'models'}->[0] || return 0; return $model->get_n_columns; } # gtk_tree_model_get_column_type # sub GET_COLUMN_TYPE { my ($self, $col) = @_; if (DEBUG) { print "TreeModelConcat get_column_type\n"; } my $model = $self->{'models'}->[0] or croak "No models"; return $model->get_column_type ($col); } # gtk_tree_model_get_iter # sub GET_ITER { my ($self, $path) = @_; if (DEBUG) { print "TreeModelConcat get_iter ",$path->to_string,"\n"; } if ($path->get_depth == 0) { return undef; } my @indices = $path->get_indices; my $offset = 0; foreach my $model (@{$self->{'models'}}) { my $len = $model->iter_n_children (undef); if ($offset + $len > $indices[0]) { $indices[0] -= $offset; my $subpath = Gtk2::TreePath->new_from_indices (@indices); my $subiter = $model->get_iter ($subpath); return _subiter_to_iter ($self, $model, $subiter); } } return undef; } # gtk_tree_model_get_path # sub GET_PATH { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat get_path\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); my $subpath = $model->get_path; return _subpath_to_path ($self, $model, $subpath); } # gtk_tree_model_get_value # sub GET_VALUE { my ($self, $iter, $col) = @_; if (DEBUG) { print "TreeModelConcat get_value ",$iter->[1]," col=$col\n"; } use Data::Dumper; print Dumper($self); my ($model, $subiter) = _iter_to_subiter ($self, $iter); return $model->get_value ($subiter, $col); } # gtk_tree_model_iter_next # sub ITER_NEXT { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat iter_next\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); if (my $nextsubiter = $model->iter_next ($subiter)) { return _subiter_to_iter ($self, $model, $nextsubiter); } if ($model->iter_parent ($subiter)) { return undef; # not a top-level } # top-level, look for first of next model my $models = $self->{'models'}; my $i = 0; for (;;) { if ($models->[$i] == $model) { last; } $i++; if ($i > $#$models) { die "oops, model not found"; } } for (;;) { $i++; $model = $models->[$i]; if (! $model) { return undef; } $subiter = $model->get_iter_first; if ($subiter) { return _subiter_to_iter ($self, $model, $subiter); } } } # gtk_tree_model_iter_children # sub ITER_CHILDREN { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat iter_children\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); $subiter = $model->iter_children ($subiter); if (! $subiter) { return undef; } return _subiter_to_iter ($self, $model, $subiter); } # gtk_tree_model_iter_has_child # sub ITER_HAS_CHILD { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat has_child\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); # note Gtk2 prior to 1.183 demands numeric return (zero or non-zero) return ($model->has_child ($subiter) ? 1 : 0); } # gtk_tree_model_iter_n_children # sub ITER_N_CHILDREN { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat iter_n_children\n"; } if (defined $iter) { my ($model, $subiter) = _iter_to_subiter ($self, $iter); return $model->iter_n_children ($subiter); } else { my $total = 0; foreach my $model (@{$self->{'models'}}) { $total += $model->iter_n_children (undef); } return $total; } } # gtk_tree_model_iter_nth_child # sub ITER_NTH_CHILD { my ($self, $iter, $n) = @_; if (DEBUG) { print "TreeModelConcat iter_nth_child $n\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); $subiter = $model->iter_nth_child ($subiter); if (! $subiter) { return undef; } return _subiter_to_iter ($self, $model, $subiter); } # gtk_tree_model_iter_parent # sub ITER_PARENT { my ($self, $iter) = @_; if (DEBUG) { print "TreeModelConcat iter_parent\n"; } my ($model, $subiter) = _iter_to_subiter ($self, $iter); $subiter = $model->iter_nth_child ($subiter); if (! $subiter) { return undef; } return _subiter_to_iter ($self, $model, $subiter); } #------------------------------------------------------------------------------ sub _do_row_changed { my ($model, $subpath, $subiter, $ref_weak_self) = @_; my $self = $$ref_weak_self || return; if (DEBUG) { print "TreeModelConcat row_changed\n";} # old iters no good after a signal unless ($model->get_flags & 'iters-persist') { $self->{'mhash'}->{$model} = (); } my $iter = _subiter_to_iter ($self, $model, $subiter); my $path = _subpath_to_path ($self, $model, $subpath); $self->row_changed ($path, $iter); } sub _do_row_inserted { my ($model, $subpath, $subiter, $ref_weak_self) = @_; my $self = $$ref_weak_self || return; if (DEBUG) { print "TreeModelConcat row_inserted\n";} $self->{'mhash'}->{$model} = (); # new numbering if ($subpath->get_depth == 0) { $self->{'offsets'} = (); # new sizes } my $iter = _subiter_to_iter ($self, $model, $subiter); my $path = _subpath_to_path ($self, $model, $subpath); $self->row_inserted ($path, $iter); } sub _do_row_deleted { my ($model, $subpath, $ref_weak_self) = @_; my $self = $$ref_weak_self || return; if (DEBUG) { print "TreeModelConcat row_deleted\n";} $self->{'mhash'}->{$model} = (); # new numbering if ($subpath->get_depth == 0) { $self->{'offsets'} = (); # new sizes } $self->row_deleted (_subpath_to_path ($self, $model, $subpath)); } sub _do_rows_reordered { my ($model, $subpath, $subiter, $subaref, $ref_weak_self) = @_; my $self = $$ref_weak_self || return; if (DEBUG) { print "TreeModelConcat rows_reordered\n";} $self->{'mhash'}->{$model} = (); # new numbering my $aref; if ($subpath->get_depth == 0) { # top-level, $aref->[$newpos] == $oldpos, must apply offset to both pos my $offset = _model_offset ($self, $model); $aref = [ 0 .. $offset-1, map {$_+$offset} @$subaref ] } else { # sub-level $aref = $subaref; } my $iter = _subiter_to_iter ($self, $model, $subiter); my $path = _subpath_to_path ($self, $model, $subpath); $self->rows_reordered ($path, $iter, $aref); } #------------------------------------------------------------------------------ sub _subpath_to_path { my ($self, $model, $subpath) = @_; my @indices = $subpath->get_indices; if (@indices) { $indices[0] += _model_offset ($self, $model); } return Gtk2::TreePath->new_from_indices (@indices); } sub _model_offset { my ($self, $model) = @_; my $offset = $self->{'offsets'}->{$model}; if (defined $offset) { return $offset; } return ($self->{'offsets'}->{$model} = do { my $offset = 0; foreach my $m (@{$self->{'models'}}) { if ($m == $model) { last; } $offset += $m->iter_n_children(undef); } }); } sub _iter_to_subiter { my ($self, $iter) = @_; use Data::Dumper; print Dumper($iter); if (! defined $iter) { croak; return ($self->{'models'}->[0], undef); } if ($iter->[0] != $self+0) { croak "iter is not for this ".ref($self) ." (id ",$iter->[0]," want ",$self+0,")\n"; } my $a = $iter->[2]; if (DEBUG) { print " extract subiter ",$a->[0]," ",$a->[1],"\n"; } return @$a; # (model, subiter) } sub _subiter_to_iter { my ($self, $model, $subiter) = @_; my $path = $model->get_path ($subiter); my $pstr = $path->to_string; my $mh = $self->{'mhash'}->{$model}; my $a = ($mh->{$pstr} ||= [ $model, $subiter ] ); print Dumper($a); print Dumper($mh); if (DEBUG) { print " make iter [$model,$subiter]\n"; } use Data::Dumper; print Dumper($self); return [ $self+0, 0, $a, undef ]; } #------------------------------------------------------------------------------ 1; __END__