#!/usr/bin/env perl -T

use strict;
use warnings;

use Tk;

$ENV{HOME} =~ /^(.*)$/;
$ENV{HOME} = $1;

my $widget_list_joiner = '~';

my $mw = MainWindow->new(-title => 'Toplevel Lister');
$mw->geometry('400x300+50+50');

my $tl = $mw->Toplevel;
$tl->Button(-text => 'Close', -command => sub { $tl->withdraw })->pack;
$tl->raise;

my $action_F = $mw->Frame()->pack(-side => 'bottom');
my $exit_B = $action_F->Button(-text => 'Exit', -command => sub { exit })->pack;

my $output_F = $mw->Frame()->pack;
my $info_T = $output_F->Scrolled('Text', -scrollbars => 'osoe')->pack;

$info_T->insert(end => '$mw->name : ' . $mw->name . "\n");

my @interps = $mw->interps;
$info_T->insert(end => '$mw->interps : ' . "\n");
for (sort @interps) {
    $info_T->insert(end => "\t$_\n");
    $info_T->insert(end => "\tToplevels:\n");
    my $toplevel_list = $mw->send($_ => undef);
    for (split $widget_list_joiner => $toplevel_list) {
        $info_T->insert(end => "\t\t$_\n");
    }
}

MainLoop;

sub Tk::Receive {
    my $mw = shift;
    return join $widget_list_joiner => $mw, $mw->children;
}