view release on metacpan or  search on metacpan

lib/Gtk2/Ex/ListModelConcat.pm  view on Meta::CPAN

#use Smart::Comments;

our $VERSION = 11;

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) = @_;