File Coverage

blib/lib/Gtk2/Ex/ToolItem/CheckButton.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 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::ToolItem::CheckButton;
use 5.008;
use strict;
use warnings;
use Gtk2;
use Scalar::Util;

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

our $VERSION = 48;

use Glib::Object::Subclass
  'Gtk2::ToolItem',
  interfaces => [
                 # Gtk2::Buildable new in Gtk 2.12, omit if not available
                 Gtk2::Widget->isa('Gtk2::Buildable') ? 'Gtk2::Buildable' : (),
                ],
  signals => { destroy => \&_do_destroy,
               notify  => \&_do_notify,
               create_menu_proxy => \&_do_create_menu_proxy,
             },
  properties => [ Glib::ParamSpec->string
                  ('active',
                   'Active',
                   'Blurb.',
                   '',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->string
                  ('label',
                   'Label',
                   'Blurb.',
                   '',
                   Glib::G_PARAM_READWRITE),
                ];

sub INIT_INSTANCE {
  my ($self) = @_;
  my $checkbutton = Gtk2::CheckButton->new;
  $checkbutton->show;
  $checkbutton->signal_connect ('notify::active',
                                \&_do_checkbutton_notify_active);
  $self->add ($checkbutton);
}

sub FINALIZE_INSTANCE {
  my ($self) = @_;
  ### CheckButton FINALIZE_INSTANCE() ...

  # must explicitly destroy MenuItem since it normally has a circular
  # reference between the MenuItem and its AccelLabel child
  if (my $menuitem = delete $self->{'menuitem'}) {
    $menuitem->destroy;
  }
}
sub _do_destroy {
  my ($self) = @_;
  ### CheckButton _do_destroy()...
  FINALIZE_INSTANCE($self); # must explicitly destroy the menuitem
  $self->signal_chain_from_overridden;
}

sub GET_PROPERTY {
  my ($self, $pspec) = @_;
  ### ToolItem-CheckButton GET_PROPERTY: $pspec->get_name
  my $checkitem;
  return (($checkitem = $self->get_child)
          && $checkitem->get($pspec->get_name));
}
sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  ### ToolItem-CheckButton SET_PROPERTY: $pspec->get_name
  my $pname = $pspec->get_name;

  if ($pname eq 'active' || $pname eq 'label') {
    foreach my $target ($self->get_child, $self->{'menuitem'}) {
      if ($target) {
        $target->set_property ($pname => $newval);
      }
    }

  } else {
    $self->{$pname} = $newval;

    # Not implemented yet, just using the toolitem label ...
    # if ($pname eq 'overflow_mnemonic') {
    #   # propagate
    #   if (my $menuitem = $self->{'menuitem'}) {
    #     $menuitem->set_label (_mnemonic_text ($self));
    #   }
    # }
  }
}

# 'notify' on self
sub _do_notify {
  my ($self, $pspec) = @_;
  ### CheckButton _do_notify() ...
  $self->signal_chain_from_overridden ($pspec);

  my $pname = $pspec->get_name;
  if ($pname eq 'tooltip_text') {
    if (my $menuitem = $self->{'menuitem'}) {
      # if tooltip-text available on $self then is available on $menuitem
      $menuitem->set_property (tooltip_text => $self->get('tooltip-text'));
    }
  }
}

sub _do_checkbutton_notify_active {
  my ($checkbutton, $pspec, $ref_weak_self) = @_;
  my $self = $checkbutton->get_parent || return;
  ### ToolItem-CheckButton _do_checkbutton_notify_active() ...
  if (my $menuitem = $self->{'menuitem'}) {
    $menuitem->set_active ($checkbutton->get_active);
  }
  $self->notify('active');
}

sub _do_create_menu_proxy {
  my ($self) = @_;
  ### ToolItem-CheckButton _do_create_menu_proxy() ...

  my $menuitem;
  if (! ($menuitem = $self->{'menuitem'})) {
    my $label = $self->get_child->get('label');
    $menuitem = $self->{'menuitem'}
      # CheckMenuItem->new() doesn't like undef, pass no args for that
      = Gtk2::CheckMenuItem->new (defined $label ? $label : ());

    # initial and subsequent sensitivity propagated by GtkToolItem
    if ($self->find_property('tooltip-text')) { # new in Gtk 2.12
      $menuitem->set_property (tooltip_text => $self->get('tooltip-text'));
    }
    # or ConnectProperties ...
    Scalar::Util::weaken (my $weak_self = $self);
    $menuitem->signal_connect ('notify::active' => \&_do_menu_notify_active,
                               \$weak_self);
  }
  $self->set_proxy_menu_item (__PACKAGE__, $menuitem);
  return 1;
}


sub _do_menu_notify_active {
  my ($menuitem, $pspec, $ref_weak_self) = @_;
  ### ToolItem-CheckButton _do_menu_notify_active()...
  my $self = $$ref_weak_self || return;
  my $checkitem = $self->get_child || return;
  $checkitem->set_active ($menuitem->get_active);
}

sub get_active {
  my ($self) = @_;
  my $checkitem;
  return (($checkitem = $self->get_child)
          && $checkitem->get_active);
}
sub set_active {
  my ($self, $active) = @_;
  if (my $checkitem = $self->get_child) {
    $checkitem->set_active ($active);
  }
}

#------------------------------------------------------------------------------
# Gtk2::Buildable interface

sub GET_INTERNAL_CHILD {
  my ($self, $builder, $name) = @_;
  if ($name eq 'checkbutton') {
    return $self->get_child;
  }
  if ($name eq 'overflow_menuitem') {
    $self->signal_emit ('create-menu-proxy');
    return $self->retrieve_proxy_menu_item;
  }
  # ENHANCE-ME: Will Gtk2::Buildable expect anything for chaining up?
  return undef;
}

1;
__END__