File Coverage

blib/lib/Gtk2/Ex/ToolItem/ComboEnum.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 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::ToolItem::ComboEnum;
use 5.008;
use strict;
use warnings;
use Gtk2;
use Gtk2::Ex::ContainerBits;
use Gtk2::Ex::ComboBox::Enum 5; # v.5 for get_active_nick(),set_active_nick()

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

our $VERSION = 32;

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 => { create_menu_proxy => \&_do_create_menu_proxy,
             },
  properties => [
                 # FIXME: default enum-type is undef but
                 # Glib::ParamSpec->string() doesn't allow that until
                 # Perl-Glib 1.240, in which case have
                 # Glib::ParamSpec->gtype().
                 #
                 (Glib::Param->can('gtype')
                  ?
                  # new in Glib 2.10 and Perl-Glib 1.240
                  Glib::ParamSpec->gtype
                  ('enum-type',
                   'Enum type',
                   'The enum class to display.',
                   'Glib::Enum',
                   Glib::G_PARAM_READWRITE)
                  :
                  Glib::ParamSpec->string
                  ('enum-type',
                   'Enum type',
                   'The enum class to display.',
                   '',
                   Glib::G_PARAM_READWRITE)),

                 Glib::ParamSpec->string
                 ('active-nick',
                  'Active nick',
                  'The selected enum value, as its nick.',
                  (eval {Glib->VERSION(1.240);1}
                   ? undef # default
                   : ''),  # no undef/NULL before Perl-Glib 1.240
                  Glib::G_PARAM_READWRITE),

                 Glib::ParamSpec->string
                 ('overflow-mnemonic',
                  'Overflow menu mnemonic',
                  'A mnemonic label string to show in the overflow menu.  Default is some mangling of the enum-type.',
                  (eval {Glib->VERSION(1.240);1}
                   ? undef # default
                   : ''),  # no undef/NULL before Perl-Glib 1.240
                  Glib::G_PARAM_READWRITE),
                ];

sub INIT_INSTANCE {
  my ($self) = @_;
  my $combobox = Gtk2::Ex::ComboBox::Enum->new;
  $combobox->show;
  $combobox->signal_connect ('notify::active-nick'  => \&_do_combobox_notify);
  $combobox->signal_connect ('notify::enum-type'    => \&_do_combobox_notify);
  $combobox->signal_connect ('notify::add-tearoffs'
                             => \&_do_combobox_notify_add_tearoffs);
  $self->add ($combobox);
}

sub FINALIZE_INSTANCE {
  my ($self) = @_;
  if (my $menuitem = delete $self->{'menuitem'}) {
    $menuitem->destroy;  # destroy circular MenuItem<->AccelLabel
  }
}

sub GET_PROPERTY {
  my ($self, $pspec) = @_;
  my $pname = $pspec->get_name;
  ### ComboEnum GET_PROPERTY: $pname

  if ($pname eq 'enum_type' || $pname eq 'active_nick') {
    ### fetch from combobox: $self->get_child && $self->get_child->get($pname)
    my $combobox;
    return (($combobox = $self->get_child)  # no child when destroyed, maybe
            && $combobox->get($pname));
  }

  return $self->{$pname};
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  ### ComboEnum SET_PROPERTY: $pname, $newval

  if ($pname eq 'enum_type' || $pname eq 'active_nick') {
    foreach my $target
      ($self->get_child,
       ($self->{'menuitem'} && $self->{'menuitem'}->get_submenu)) {

      if ($target) { # no children when destroyed maybe
        ### ComboEnum propagate to: "$target"
        $target->set ($pname => $newval);
      }
    }
  } else {
    $self->{$pname} = $newval;
  }

  if ($pname eq 'overflow_mnemonic'
      || $pname eq 'enum_type') { # for when showing enum-type as fallback
    _update_overflow_mnemonic($self);
  }
}

sub _do_combobox_notify {
  my ($combobox, $pspec) = @_;
  ### ComboEnum _do_combobox_notify()
  if (my $self = $combobox->parent) { # in case unparented maybe
    $self->notify($pspec->get_name);
  }
}
sub _do_combobox_notify_add_tearoffs {
  my ($combobox, $pspec) = @_;
  ### ComboEnum _do_combobox_notify_add_tearoffs()
  if (my $self = $combobox->parent) { # in case unparented maybe
    _update_overflow_tearoff ($self);
  }
}

sub _do_create_menu_proxy {
  my ($self) = @_;
  ### _do_create_menu_proxy()
  my $combobox = $self->get_child || return 0;  # if being destroyed maybe

  if (! $self->{'menuitem'}) {
    require Gtk2::Ex::Menu::EnumRadio;
    require Glib::Ex::ConnectProperties;
    my $menu = Gtk2::Ex::Menu::EnumRadio->new;
    # enum-type first otherwise active-nick not settable
    Glib::Ex::ConnectProperties->new ([$self,'enum-type'],
                                      [$menu,'enum-type']);
    Glib::Ex::ConnectProperties->new ([$self,'active-nick'],
                                      [$menu,'active-nick']);
    # ComboBox tearoff-title new in 2.10, but Menu tearoff-title always present
    if ($combobox->find_property('tearoff-title')) {
      Glib::Ex::ConnectProperties->new ([$combobox,'tearoff-title'],
                                        [$menu,'tearoff-title']);
    }
    ### initial menu enum-type: $menu->get_active_nick
    ### initial menu active-nick: $menu->get_active_nick

    # prompt store to $self->{'menuitem'} for safe destroy if any error
    my $menuitem = $self->{'menuitem'} = Gtk2::MenuItem->new_with_mnemonic ('');
    $menuitem->set_submenu ($menu);
    _update_overflow_mnemonic ($self); # initial label
    _update_overflow_tearoff ($self);  # initial tearoff
  }

  $self->set_proxy_menu_item (__PACKAGE__, $self->{'menuitem'});
  return 1;
}

sub _update_overflow_mnemonic {
  my ($self) = @_;
  ### ComboEnum _update_overflow_mnemonic()

  my $menuitem = $self->{'menuitem'} || return;
  my $label = $menuitem->get_child || return; # just in case gone

  my $str = $self->{'overflow_mnemonic'};
  if (! defined $str) {
    if (my $combobox = $self->get_child) {
      if (defined ($str = $combobox->get('enum-type'))) {
        $str =~ s/.*:://;
      } else {
        $str = $combobox->get_name;
      }
    } else {
      $str = $self->get_name;
    }
    require Glib::Ex::EnumBits;
    $str = Glib::Ex::EnumBits::to_display_default (undef, $str);
    require Gtk2::Ex::MenuBits;
    $str = Gtk2::Ex::MenuBits::mnemonic_escape($str);
  }
  ### $str
  $label->set_label ($str);
}

sub _update_overflow_tearoff {
  my ($self) = @_;
  ### ComboEnum _update_overflow_tearoff()
  my $combobox = $self->get_child || return 0;  # if being destroyed maybe
  my $menuitem = $self->{'menuitem'} || return;
  my $menu = $menuitem->get_submenu || return;  # if being destroyed maybe
  $combobox->find_property('add-tearoffs') || return;  # not in Gtk 2.4
  if ($combobox->get('add-tearoffs')) {
    ### tearoff wanted
    unless (List::Util::first
            {$_->isa('Gtk2::TearoffMenuItem')}
            $menu->get_children) {
      ### add new TearoffMenuItem
      $menu->prepend (Gtk2::TearoffMenuItem->new);
    }
  } else {
    ### tearoff not wanted
    Gtk2::Ex::ContainerBits::remove_widgets
        ($menu,
         grep {$_->isa('Gtk2::TearoffMenuItem')} $menu->get_children);
  }
}

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

sub GET_INTERNAL_CHILD {
  my ($self, $builder, $name) = @_;
  if ($name eq 'combobox') {
    return $self->get_child;
  }
  return undef;
}

1;
__END__