File Coverage

blib/lib/Gtk2/Ex/ComboBoxBits.pm

Criterion	Covered	Total	%
statement	12	41	29.2
branch	0	18	0.0
condition	0	6	0.0
subroutine	4	9	44.4
pod	4	4	100.0
total	20	78	25.6

# Copyright 2010, 2011 Kevin Ryde

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

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

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(get_active_path
                    set_active_path
                    set_active_text
                    find_text_iter);

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

our $VERSION = 32;

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

sub get_active_path {
  my ($combobox) = @_;
  my ($model, $iter);
  return (($model = $combobox->get_model)
          && ($iter = $combobox->get_active_iter)
          && $model->get_path ($combobox->get_active_iter));
}

sub set_active_path {
  my ($combobox, $path) = @_;
  ### set_active_path()

  # Non-existent rows go to set_active(-1) since the Perl-Gtk2
  # set_active_iter() doesn't accept undef (NULL) until 1.240.
  # If ready to demand that version could
  #   $combobox->set_active_iter ($model && $path && $model->get_iter($path));

  if ($path) {
    if ($path->get_depth == 1) {
      # top-level row using set_active()
      $combobox->set_active ($path->get_indices);
      return;
    }

    if (my $model = $combobox->get_model) {
      if (my $iter = $model->get_iter($path)) {
        $combobox->set_active_iter ($iter);
        return;
      }
    }
  }
  # path=undef, or no model, or path not in model
  # FIXME: ->set_active(-1) spits a warning in gtk 2.28 if no model,
  # want Gtk2 1.240 for ->set_active_iter(undef)
  if ($combobox->get_model) {
    $combobox->set_active (-1);
  }
}

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

sub set_active_text {
  my ($combobox, $str) = @_;
  ### ComboBoxBits set_active_text(): $str

  if (defined $str && (my $iter = find_text_iter ($combobox, $str))) {
    ### $iter
    $combobox->set_active_iter ($iter);
  } else {
    # As of Gtk 2.20 set_active() throws a g_log() warning if there's no
    # model set.  Prefer to quietly do nothing to make no active item when
    # already no active item.
    if ($combobox->get_model) {
      # pending perl-gtk 1.240 set_active_iter() accepting undef
      $combobox->set_active (-1);
    }
  }
  ### set_active_text() active num now: $combobox->get_active
}

sub find_text_iter {
  my ($combobox, $str) = @_;
  ### ComboBoxBits find_text_iter(): $str
  my $ret;
  if (my $model = $combobox->get_model) {
    $model->foreach (sub {
                       my ($model, $path, $iter) = @_;
                       ### get_value: $model->get_value ($iter, 0)
                       if ($str eq $model->get_value ($iter, 0)) {
                         ### found at: $path->to_string
                         $ret = $iter->copy;
                         return 1; # stop
                       }
                       return 0; # continue
                     });
  }
  ### $ret
  return $ret;
}

1;
__END__