File Coverage

blib/lib/Gtk2/Ex/TreeModelBits.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Copyright 2007, 2008, 2009, 2010, 2011, 2012 Kevin Ryde

# This file is part of Gtk2-Ex-WidgetBits.
#
# Gtk2-Ex-WidgetBits 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-WidgetBits 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-WidgetBits.  If not, see .

package Gtk2::Ex::TreeModelBits;
use 5.008;
use strict;
use warnings;
use Gtk2;

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(column_contents
                    remove_matching_rows
                    all_column_types
                    iter_prev);

our $VERSION = 48;

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

sub column_contents {
  my ($model, $column) = @_;
  my @ret;

  # pre-extend, helpful for a list model style, likely to do little for an
  # actual tree
  $#ret = $model->iter_n_children(undef) - 1;

  my $pos = 0;
  $model->foreach (sub {
                     my ($model, $path, $iter) = @_;
                     $ret[$pos++] = $model->get_value ($iter, $column);
                     return 0; # keep walking
                   });
  # iterating should give n_children, trim @ret if it doesn't
  ### assert: $pos >= scalar(@ret)
  $#ret = $pos-1;

  return @ret;
}

# If a remove() might end up removing more than one row then it's expected
# to leave $iter at whatever next row then exists (at the same depth).
# A multi-remove happens for instance in Gtk2::Ex::ListModelConcat when it's
# presenting two or more copies of one submodel.
# Gtk2::Ex::TreeModelFilter::Change::remove() asks for similar from its
# child remove().
#
sub remove_matching_rows {
  my $model = shift;
  my $subr = shift;

  my @pending;
  my $iter = $model->get_iter_first;

  for (;;) {
    # undef at end of one level, pop to upper level, or finished if no upper
    $iter ||= pop @pending || last;
    ### looking at: $model->get_path($iter)->to_string

    if ($subr->($model, $iter, @_)) {
      if (! $model->remove ($iter)) {
        $iter = undef; # no more at this depth
      }
      # otherwise $iter updated to next row
      next;
    }

    my $child = $model->iter_children ($iter);
    $iter = $model->iter_next ($iter);

    if ($child) {
      ### descend to child: $model->get_path($child)->to_string
      push @pending, $iter;
      $iter = $child;
    }
  }
}

sub all_column_types {
  my ($model) = @_;
  return map { $model->get_column_type($_) } 0 .. $model->get_n_columns - 1;
}

sub iter_prev {
  my ($model, $iter) = @_;
  my $path = $model->get_path ($iter);
  return ($path->prev
          ? $model->get_iter ($path)  # path moved
          : undef); # no more nodes (last path index was 0)
}

1;
__END__