FIRST: here is the perl code/widget that I made which works:
#! /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/Memca
+ched");
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 juli
+et 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 ( "<KeyPress>" , [\&do_search , Ev ("K" )] );
# $mw = $dialog -> Show(); #HMMMMMM... WORKED; so Show() is unnee
+ded?
##############
$lb = $mw -> Scrolled ("Listbox" , -scrollbars => "se" ,
-height => 20 ,
-selectforeground => 'orange'
+,
-selectbackground => 'steelbl
+ue4' ,
) -> 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::E
+xists( $mw ); }
) -> pack (-side => 'bottom' , -fill => "x" );
$lb -> bind( '<Double-1>' , \&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()
WHAT I like about it is it sticks the vars in a listbox with a slider.
It also searches. Type in the first letter(s) and it takes you to the matching string.
I can see uses elsewhere for such a thing. In this case it is for choosing hash-keys so I can
delete Cache::Cache entries/elements
I am curious: Why isnt there a megawidget repository somewhere?
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.