File Coverage

blib/lib/Gtk2/Ex/ToolItem/OverflowToDialog.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, 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::OverflowToDialog;
use 5.008;
use strict;
use warnings;
use Gtk2;
use Scalar::Util;
use Gtk2::Ex::ContainerBits;
use Gtk2::Ex::MenuBits 35;  # v.35 for mnemonic_escape, mnemonic_undo

# 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 => { add => \&_do_add,
               destroy => \&_do_destroy,
               create_menu_proxy => \&_do_create_menu_proxy,
               notify => \&_do_notify,
               hierarchy_changed => \&_do_hierarchy_changed,
             },
  properties => [ Glib::ParamSpec->string
                  ('overflow-mnemonic',
                   'Overflow Mnemonic',
                   'Blurb.',
                   (eval {Glib->VERSION(1.240);1}
                    ? undef # default
                    : ''),  # no undef/NULL before Perl-Glib 1.240
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->object
                  ('child-widget',
                   'Child Widget',
                   'Blurb.',
                   'Gtk2::Widget',
                   Glib::G_PARAM_READWRITE),
                ];

# sub INIT_INSTANCE {
#   my ($self) = @_;
# }

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

  # don't let _update_child_position() store it back again
  delete $self->{'child_widget'};

  if (my $menuitem = delete $self->{'menuitem'}) {
    $menuitem->destroy;  # circular MenuItem<->AccelLabel, must destroy
  }
  if (my $dialog = delete $self->{'dialog'}) {
    $dialog->destroy;  # usual explicit Gtk2::Window destroy
  }
}
sub _do_destroy {
  my ($self) = @_;
  ### OverflowToDialog _do_destroy()
  FINALIZE_INSTANCE($self);
  $self->signal_chain_from_overridden;
}

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

  if ($pname eq 'child_widget') {
    $self->set_child_widget ($newval);

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

    if ($pname eq 'overflow_mnemonic') {
      # propagate
      if (my $menuitem = $self->{'menuitem'}) {
        if (my $label = $menuitem->get_child) { # perhaps gone in destruction
          $label->set_text_with_mnemonic (_mnemonic_text ($self));
        }
      }
      if (my $dialog = $self->{'dialog'}) {
        $dialog->update_text;
      }
    }
  }
}
sub _do_notify {
  my ($self, $pspec) = @_;
  ### ToolItem-OverflowToDialog _do_notify(): $pspec->get_name
  ### invocation hint: $self->signal_get_invocation_hint

  # my $n;
  #   if ($n++ > 10) {
  #   exit 1;
  # }
  # if (my $child = $self->get('child-widget')) {
  #   if ($child->isa('Gtk2::Container')) {
  #     ### child-widget: join(',', $child->get_children)
  #   }
  # }

  $self->signal_chain_from_overridden ($pspec);
  ### chain returned ...

  # The GtkToolItem gtk_tool_item_property_notify() propagates 'sensitive'
  # to the menuitem already, whatever is currently set_proxy_menu_item().
  # Send it to the dialog too.
  my $pname = $pspec->get_name;
  if ($pname eq 'sensitive' || $pname eq 'tooltip_text') {
    my $newval = $self->get($pname);
    foreach my $target ($self->{'menuitem'},
                        $self->{'dialog'} && $self->{'dialog'}->{'child_vbox'}) {
      if ($target) {
        ### propagate: "$pname to $target"
        $target->set ($pname => $newval);
      }
    }
  }
}

# 'add' class closure, per $container->add()
sub _do_add {
  my ($self, $child) = @_;
  ### ToolItem-OverflowToDialog _do_add(): "$child"

  $self->signal_chain_from_overridden ($child);
  $self->set_child_widget ($child);
}

# not documented yet
sub set_child_widget {
  my ($self, $child_widget) = @_;

  # watch out for recursion from _do_add()
  if ((Scalar::Util::refaddr($self->{'child_widget'})||0)
      == (Scalar::Util::refaddr($child_widget)||0)) {
    ### unchanged
    return;
  }

  $self->{'child_widget'} = $child_widget;
  _update_child_position ($self);

  # go through an idle handler as a workaround for some dodginess in glib
  # circa 2.30 running a notify closure from within an add closure ...
  Glib::Idle->add (sub {
                     $self->notify('child_widget');
                     return 0; # Glib::SOURCE_REMOVE;
                   });
}

sub _update_child_position {
  my ($self) = @_;
  my $child_widget = $self->{'child_widget'};
  if (my $dialog = $self->{'dialog'}) {
    my $child_vbox = $dialog->{'child_vbox'};
    if ($dialog->mapped) {
      # want $child_widget in the dialog
      Gtk2::Ex::ContainerBits::remove_all ($self);
      foreach my $old ($child_vbox->get_children) {
        if ((Scalar::Util::refaddr($old)||0)
            == (Scalar::Util::refaddr($child_widget)||0)) {
          # already in the dialog, don't pack
          undef $child_widget;
        } else {
          $child_vbox->remove ($old);
        }
      }
      if ($child_widget) {
        # expand/fill with dialog
        $child_vbox->pack_start ($child_widget, 1,1,0);
      }
      return;
    }

    # want $child_widget in the toolitem
    Gtk2::Ex::ContainerBits::remove_all ($child_vbox);
  }
  _bin_set_child ($self, $child_widget);
}

# Gtk2::Ex::BinBits::set_child ($bin, $child)
#
# Set the child widget in C<$bin> to C<$child>.  This is done by a C
# of any existing child and an C of C<$child>.  C<$child> can be undef
# to set no child.
#
# When making a subclass of C this function can be imported to
# have it available as a method on the new class, if desired.
#
sub _bin_set_child {
  my ($bin, $child) = @_;
  if (my $old_child = $bin->get_child) {
    if ((Scalar::Util::refaddr($child)||0) == (Scalar::Util::refaddr($old_child)||0)) {
      return;
    }
    $bin->remove ($old_child);
  }
  if (defined $child) {
    if (my $old_parent = $child->get_parent) {
      $old_parent->remove ($child);
    }
    $bin->add ($child);
  }
}

# # Gtk2::Ex::ContainerBits::set_children ($container, $child, ...)
# #
# # Set the children of C<$container> to the given C<$child...> arguments.
# # For convenience any Cs in the arguments are ignored.
# #
# # This is done by a C of any existing children which are not listed,
# # and an add C of any new additional children given.  If a C<$child> if
# # in C<$container> but not in the position given by the arguments then it's
# # removed and re-added.
# #
# # when making a subclass of C this function can be imported
# # to have it available as a method on the new class, if desired.
# #
# sub _container_set_children {
#   my $container = shift;
#   @_ = grep {defined} @_;
#   my @remove;
#   my @children = $container->get_children;
#   while (@children) {
#     my $old_child = shift @children;
#     if ((Scalar::Util::refaddr($_[0])||0)
#         == (Scalar::Util::refaddr($children[0])||0)) {
#       shift @_;
#     } else {
#       push @remove, $old_child;
#     }
#   }
#   Gtk2::Ex::ContainerBits::remove_widgets ($container, @remove);
#   foreach my $add (@_) {
#     $container->add ($add);
#   }
# }

# 'hierarchy-changed' class closure handler
sub _do_hierarchy_changed {
  my ($self, $pspec) = @_;
  ### ToolItem-OverflowToDialog _do_hierarchy_changed()

  # cf ConnectProperties self#toplevel -> dialog#transient-for
  # except transient-for prop new in 2.10
  if (my $dialog = $self->{'dialog'}) {
    $dialog->update_transient_for;
  }
}

sub _do_create_menu_proxy {
  my ($self) = @_;
  ### ToolItem-OverflowToDialog _do_create_menu_proxy()
  ### visible: $self->get('visible')

  $self->{'menuitem'} ||= do {
    # initial and subsequent sensitivity propagated by GtkToolItem
    my $menuitem = Gtk2::MenuItem->new_with_mnemonic (_mnemonic_text($self));
    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 (activate => \&_do_menu_activate, \$weak_self);
    $menuitem
  };

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

sub _do_menu_activate {
  my ($menuitem, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  ### ToolItem-OverflowToDialog _do_menu_activate()
  _dialog($self)->present_for_menuitem ($menuitem);
}
sub _dialog {
  my ($self) = @_;
  return ($self->{'dialog'} || do {
    ### create new dialog
    require Gtk2::Ex::ToolItem::OverflowToDialog::Dialog;
    my $d = $self->{'dialog'}
      = Gtk2::Ex::ToolItem::OverflowToDialog::Dialog->new (toolitem => $self);
    _do_hierarchy_changed ($self); # initial transient_for
    $d
  });
}

sub _mnemonic_text {
  my ($self) = @_;
  my $str = $self->{'overflow_mnemonic'};
  if (defined $str) {
    return $str;
  } elsif (my $child_widget = $self->{'child_widget'}) {
    return Gtk2::Ex::MenuBits::mnemonic_escape ($child_widget->get_name);
  } else {
    return '';
  }
}

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

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

1;
__END__