Gtk2::Ex::ToolItem::OverflowToDialog - toolitem overflowing to a dialog

 use Gtk2::Ex::ToolItem::OverflowToDialog;
 my $toolitem = Gtk2::Ex::ToolItem::OverflowToDialog->new
                  (child_widget => $widget);

    Gtk2::Widget
      Gtk2::Container
        Gtk2::Bin
          Gtk2::ToolItem
            Gtk2::Ex::ToolItem::OverflowToDialog

       toolbar overflow  
       +---+             
       | V |                   dialog                  
       +-----------+           +----------------------+
       | Other     |           |        My Item       |
       | My Item   |  -->      | +------------------+ |
       | Other     |           | |   child-widget   | |
       +-----------+           | +------------------+ |
                               +----------------------+
                               | Close                |
                               +----------------------+

# Copyright 2010, 2011 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 <http://www.gnu.org/licenses/>.

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 = 43;

use Glib::Object::Subclass
  'Gtk2::ToolItem',
  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()
  if (my $menuitem = delete $self->{'menuitem'}) {
    $menuitem->destroy;  # circular MenuItem<->AccelLabel
  }
  if (my $dialog = delete $self->{'dialog'}) {
    $dialog->destroy;  # usual explicit Gtk2::Window
  }
}
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
  $self->signal_chain_from_overridden ($pspec);

  # 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) = @_;
  $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);
  $self->notify('child_widget');
}

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<remove>
# of any existing child and an C<add> of C<$child>.  C<$child> can be undef
# to set no child.
#
# When making a subclass of C<Gtk2::Bin> 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 C<undef>s in the arguments are ignored.
# #
# # This is done by a C<remove> of any existing children which are not listed,
# # and an add C<add> 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<Gtk2::Container> 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()

  my $dialog = ($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
  });
  $dialog->present_for_menuitem ($menuitem);
}

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 '';
  }
}

1;
__END__