The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Tk;
use Tk::HList;
use Win32::CtrlGUI;

my $mw = MainWindow->new;
my $wintest = Wintest->new($mw);
MainLoop;




package Wintest;

use strict;

sub new {
  my $class = shift;
  my($mw, $parent) = @_;

  my $self = {
    mw => $mw,
    parent => $parent,
  };

  bless $self, $class;
  $self->_init;
  $self->_refresh;
}

sub _init {
  my $self = shift;

  $self->{mw}->Busy;
  $self->{mw}->update;

  $self->{title} = "$self->{parent}" || "All Windows";
  $self->{mw}->title("Tk Window Enumerator: $self->{title}");
  $self->{label} = $self->{mw}->Label(-text => $self->{title}, -anchor => 'w')->pack(-side => 'top');
  $self->{hlist} = $self->{mw}->Scrolled('HList', -scrollbars => 'se', -separator => '|', -font => 'Arial 8',
                   -command => sub {Wintest->new($self->{mw}->Toplevel, $self->{hlist}->info('data', $_[0]))})->pack(
                   -side => 'top', -expand => 1, -fill => 'both');
  $self->{refresh} = $self->{mw}->Button(-text => 'Refresh', -command => sub {$self->_refresh})->pack(-side => 'left');
  $self->{printatom} = $self->{mw}->Button(-text => 'Print Atom', -command => sub {
    if ($self->{parent}) {
      my $parent = &_clean_text($self->{parent});
      my $child = &_clean_text($self->{hlist}->info('data', $self->{hlist}->info('selection')));
      print "\natom => [criteria => [pos => \"$parent\", \"$child\"],\n         action => ''],\n\n";
    } else {
      my $parent = &_clean_text($self->{hlist}->info('data', $self->{hlist}->info('selection')));
      print "\natom => [criteria => [pos => \"$parent\"],\n         action => ''],\n\n";
    }
  })->pack(-side => 'left');
  $self->{mw}->update;
  $self->{mw}->focusForce;
  $self->{mw}->update;
  $self->{mw}->Unbusy;
}

sub _refresh {
  my $self = shift;

  $self->{mw}->Busy;
  $self->{mw}->update;

  $self->{hlist}->delete('all');

  my(@list);
  if ($self->{parent}) {
    @list = $self->{parent}->enum_child_windows;
  } else {
    @list = Win32::CtrlGUI::enum_windows();
  }
  @list = map {$_->[0]} sort {lc($a->[1]) cmp lc($b->[1]) || $a->[1] cmp $b->[1]} grep {$_->[1]} map {[$_, "$_"]} @list;

  my $i = 1;
  foreach my $window (@list) {
    $self->{hlist}->add($i++, -itemtype => 'text', -text => "$window", -data => $window);
  }

  $self->{mw}->Unbusy;
}

sub new_win {
  my $self = shift;
  my($parent) = @_;

  my $new_mw = $self->{mw}->Toplevel;
}

sub _clean_text {
  my($string) = @_;

  $string =~ s/([&\$"\@\\])/\\$1/g;
  $string =~ s/\t/\\t/g;
  $string =~ s/\n/\\n/g;
  return $string;
}