#! /usr/pkg/bin/perl use warnings; # use diagnostics; use Tk; use Tk::Entry; unshift (@INC , "/usr/pkg/lib/perl5/site_perl/5.30.0/x86_64-netbsd-thread-multi/Tk"); unshift (@INC , "/usr/pkg/lib/perl5/vendor_perl/5.30.0/Cache/Memcached"); unshift (@INC , "/usr/pkg/lib/perl5/site_perl/5.30.0/Cache"); $mw = MainWindow -> new(); $mw -> title ("Listbox"); @choices = qw /alpha beta charlie delta echo foxtrot hotel india juliet kilo lima motel nancy oscar papa quebec radio sierra tango uniform victor whiskey xray yankee zulu oin gloin beorn gandalf elrond eowyn/; $header_msg = "ENTER a KEY name: "; my ($search , $oldsearch); ##--------------------------------------------------------------------------------## &listbox1 (@choices , $header_msg ); ##WORKS!! Make sure the $msg is last element ##--------------------------------------------------------------------------------## MainLoop; sub listbox1 { my(@choices , $header_msg ); $header_msg = pop (@_) ; @choices = @_ ; my $dialog = $mw -> Label (-text => $header_msg ) -> pack( -side => "top" ); $dialog = $mw -> Entry (-textvariable => \$search, ) -> pack ( -side => "top" , -fill => "x" ); $dialog -> bind ( "" , [\&do_search , Ev ("K" )] ); # $mw = $dialog -> Show(); #HMMMMMM... WORKED; so Show() is unneeded? ############## $lb = $mw -> Scrolled ("Listbox" , -scrollbars => "se" , -height => 20 , -selectforeground => 'orange', -selectbackground => 'steelblue4' , ) -> pack(-side => "top") ; $lb -> insert ( "end" , sort @choices ); ### MAKE '@choices' the list of $keys my $f = $mw -> Frame( ) -> pack(-side => 'bottom' , -fill => "x" ) ; $f -> Button ( -text => "QUIT" , -background => 'red', # -relief => 'sunken' -command => sub { ( $mw -> destroy() ) if Tk::Exists( $mw ); } ) -> pack (-side => 'bottom' , -fill => "x" ); $lb -> bind( '' , \&get_choice ); } ## CLOSE listbox1() ################## sub get_choice { my $mychoice = $lb -> get( 'active'); print "\$mychoice = : $mychoice\n\n "; } sub do_search { my ($entry , $key) = @_; return if ( $key =~ /backspace/ ); return if ( $oldsearch eq $search ); my @list = $lb -> get(0 , "end"); foreach ( 0 .. $#list ) { if ($list [$_] =~ /^$search/ ) { $lb -> see($_); $lb -> selectionClear( 0 , "end" ); $lb -> selectionSet ($_); last; } } $oldsearch = $search; } ## CLOSE do_search()