#!/usr/bin/perl use strict; use warnings; use Tk; { # for package package Tk::GUIask; # Pop up a box asking for simple input: # filename, dir, etc use List::Util qw( first ); use base qw/ Tk::Frame /; # Frame-based composite Construct Tk::Widget 'GUIask'; # install MyNewWidget in pTk namespace sub ClassInit # called once to initialize new class { my($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate # called to build each widget instance { my($self, $args) = @_; $self->SUPER::Populate($args); #my $search = ''; my $frame = $self->Frame( -borderwidth => 5, -relief => 'ridge', )->pack(-fill=> 'both', -expand=> 1); my $label = $frame->Label( -fg => 'blue', -font => 30, )->pack(-fill => 'x'); my $search; my $entry = $frame->Entry( -textvariable => \$search, -validate => 'key', # -validatecommand => sub # { # my ($want) = @_; # length $want or return 1; # my @list = $lbox->get(0 , "end"); # my $item = first { $list[$_] =~ /^\Q$want\E/ } 0 .. $#list; # defined $item or return 0; # $lbox->selectionClear( 0 , "end" ); # $lbox->selectionSet($item); # $lbox->see($item); # 1 # to allow # }, )->pack(-fill => 'x'); my $button = $frame -> Button( -text => "Abort", -bg => 'red', -command => sub { #$mw -> destroy(); ($frame -> destroy() ) if Tk::Exists($frame ); } ) ->pack(-fill => 'x' ); $self->ConfigSpecs( DEFAULT => [$entry], text => [$label] ); $self->Delegates( Construct => $entry, insert => $entry, get => $entry, curselection => $entry ); } 1; } # CLOSE package my $header_msg = "ENTER Archive name: "; my $mw = MainWindow->new; #$mw->geometry( '+900+250' ); $mw->title( ' ' ## " " must be specified for a plain frame ); my $search; my $lb = $mw->GUIask( -text => $header_msg, -textvariable => \$search, )->pack(-fill => 'both', -expand => 1, -side => 'left'); my $stuff = $lb -> get(); # print "\$search =: $stuff\n\n "; MainLoop;