#!/usr/bin/perl -w

# GTK - The GIMP Toolkit
# Copyright (C) 1995-1997 Peter Mattis, Spencer Kimball and Josh MacDo
+nald
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library 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
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/examples/socket.pl,v 1
+.7 2004/01/25 06:52:01 muppetman Exp $
#

# this was originally gtk-2.2.1/examples/buttonbox/buttonbox.c
# ported to gtk2-perl by rm

use strict;
use Glib qw/TRUE FALSE/;
use Gtk2 -init;

my $pid;
my $socket;
my $win = Gtk2::Window->new("toplevel");
$win->set_default_size(640, 480);
$win->signal_connect( 'delete_event' => sub {
        Gtk2->main_quit;
        kill(2,$pid);
        1;
    });

$socket = Gtk2::Socket->new;
$win->add($socket);

printf("win: 0x%X\n", $socket->get_id);
$pid = fork;
if( $pid < 0 )
{
    die "there's a problem here, fork";
}
if( $pid == 0 )
{
    exec(sprintf("$^X plug.pl %d\n", $socket->get_id));
}

my $quitbtn = Gtk2::Button->new_from_stock('gtk-quit');
$quitbtn->signal_connect( 'clicked' => sub {
        Gtk2->main_quit;
        1;
    });

$socket->signal_connect('plug-removed' => sub {
        print STDERR "GtkPlug Disconnected\n";
        $win->remove($socket);
        $win->add($quitbtn);
        $win->set_border_width(50);
        $quitbtn->show;
        1;
    });

$win->show_all;

Gtk2->main;

waitpid($pid, 0);
[download]

# and plug.pl

#!/usr/bin/perl -w

# GTK - The GIMP Toolkit
# Copyright (C) 1995-1997 Peter Mattis, Spencer Kimball and Josh MacDo
+nald
#
# Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for t
+he full
# list)
# 
# This library is free software; you can redistribute it and/or modify
+ it under
# the terms of the GNU Library General Public License as published by 
+the Free
# Software Foundation; either version 2.1 of the License, or (at your 
+option)
# any later version.
# 
# This library is distributed in the hope that it will be useful, but 
+WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY o
+r FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU Library General Public Licens
+e for
# more details.
# 
# You should have received a copy of the GNU Library General Public Li
+cense
# along with this library; if not, write to the Free Software Foundati
+on, Inc.,
# 59 Temple Place - Suite 330, Boston, MA  02111-1307  USA.
#
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/examples/plug.pl,v 1.4
+ 2003/09/22 00:04:23 rwmcfa1 Exp $
#

# this was originally gtk-2.2.1/examples/buttonbox/buttonbox.c
# ported to gtk2-perl by rm

use strict;

use Gtk2;

die "ERROR: give me a socket" unless( scalar($ARGV[0]) );

sleep(1);

Gtk2->init;

printf("socket_id: %X\n", $ARGV[0]);
my $plug = Gtk2::Plug->new($ARGV[0]);
$plug->set_border_width(10);

my $hbox = Gtk2::HBox->new(0,5);
$plug->add($hbox);

my $state = 1;
my $img = Gtk2::Image->new_from_stock("gtk-yes", "dialog");
$hbox->pack_start($img, 1, 1, 5);

my $vbox = Gtk2::VBox->new(0,5);
$hbox->pack_start($vbox, 1, 1, 5);

my $btn = Gtk2::Button->new("Click me before exiting!");
$vbox->pack_start($btn, 1, 1, 5);

$btn->signal_connect( "clicked" => sub {
        Gtk2->main_quit;
    });

my @array = ( $img, $state );
foreach (1..5)
{
    my $btn = Gtk2::Button->new("Just a button $_");
    $vbox->pack_start($btn, 1, 1, 5);
    $btn->signal_connect( "clicked" => sub {
            print STDERR 'btn: '.$_[0]->get_label.' state: '.
                $_[1][1]." \n";
            if( $_[1][1] )
            {
                $_[1][0]->set_from_stock('gtk-no', 'dialog');
                $_[1][1] = 0;
            }
            else
            {
                $_[1][0]->set_from_stock('gtk-yes', 'dialog');
                $_[1][1] = 1;
            }
        }, \@array
    );
}

$plug->show_all;

Gtk2->main;
[download]