$Tk::GUIask::VERSION = '1.0' ; package Tk::GUIask; use strict; # https://perlmonks.org/?node_id=11118320 use warnings; # my first pTk-MEGAWIDGET: I developed the code. It was widgetized by a "perl monk" use Tk; # THIS THING WORKS!! use base qw/ Tk::Frame /; # Frame-based composite use List::Util qw( first ); Construct Tk::Widget 'GUIask'; # install MyNewWidget in pTk namespace { # for package # 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 $lbox; # my $lbox = $frame->Scrolled( # Listbox => -scrollbars => 'se', # -height => 20, # -selectforeground => 'orange', # -selectbackground => 'steelblue4', # -exportselection => 0, # )->pack(-side => 'bottom', -fill => 'both', -expand=> 1); my $entered; my $entry = $frame->Entry( -textvariable => \$entered, # -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 # }, #1; )->pack(-fill => 'x'); my $button = $frame -> Button( -text => "Abort", -bg => 'red', -command => sub { ($frame -> destroy() ) if Tk::Exists($self ); } ) ->pack(-fill => 'x' ); $self->ConfigSpecs( DEFAULT => [$lbox], text => [$label] ); $self->Delegates( Construct => $lbox, insert => $lbox ); } 1; } # end package ############################################### #! /usr/pkg/bin/perl ## GOAL: write a simple pTk program for testing ## custom MEGA-WIDGETS ############################################################ # use strict; use warnings; ## These 2 lines give useful debug-info # use diagnostics; ## COMMENT when done debugging... use lib ("/home/tgruhn/PTK-MEGAWIDGETS" ); # use lib ("/usr/local/MEGAWIDGETS" ); ## ALTERNATE dir; to test ## MEGAWIDGETS library use Tk; use ListBox3; use GUIask; ############################################################ my $top = MainWindow->new(); ## MUST be specified as 'our ($top)' above ############################################################ ############################################################ # my $listbox = $top -> ListBox3; # $listbox -> pack(); # $top -> Button ( # -text => "Abort" , # -bg => 'red' , # -command => sub { ( $top -> destroy() ) if Tk::Exists( $top ) ; } # )-> pack ( -side => 'bottom' , -fill => 'x' ); ############################################################ ############################################################ my $GA = "ENTER A FILENAME: "; my $GUIask = $top -> GUIask( -text => $GA, ); $GUIask -> pack(); $top -> Button ( -text => "Abort" , ## THIS BLOCK ALSO WORKS!! -bg => 'red' , ## but what if I want it inside the 'GUIask' widget? -command => sub { ( $top -> destroy() ) if Tk::Exists( $top ) ; } )-> pack ( -side => 'bottom' , -fill => 'x' ); MainLoop();