Here is the latest copy of the code, and a driver-program
$Tk::GUIask::VERSION = '1.0' ; package Tk::GUIask; use strict; # https://perlmonks.org/?node_id=1111 +8320 use warnings; # my first pTk-MEGAWIDGET: I develope +d 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 cla +ss # { # my($class, $mw) = @_; # $class->SUPER::ClassInit($mw); # } sub Populate # called to build each widget instanc +e { 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 => 'oran +ge', # -selectbackground => 'stee +lblue4', # -exportselection => 0, # )->pack(-side => 'bottom', -fill => 'bo +th', -expand=> 1); my $entered; my $entry = $frame->Entry( -textvariable => \$entered, # -validate => 'key', # -validatecommand => sub # { # my ($want) = +@_; # length $want +or return 1; # my @list = $l +box->get(0 , "end"); # my $item = fi +rst { $list[$_] =~ /^\Q$want\E/ } 0 .. $#list; # defined $item + or return 0; # $lbox->select +ionClear( 0 , "end" ); # $lbox->select +ionSet($item); # $lbox->see($i +tem); # 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)' abo +ve ############################################################ ############################################################ # 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 in +side the 'GUIask' widget? -command => sub { ( $top -> destroy() ) if Tk::Ex +ists( $top ) ; } )-> pack ( -side => 'bottom' , -fill => 'x' ); MainLoop();
Right before 'MainLoop' I have a call to 'Button'. THAT WORKS -- but I want it inside of the megawidget (GUIask.pm) . If I click on 'Abort' then kill widget and make another choice from the main menu. I also wanna be able to change $GA since this will be used in different situations where user input is desired.
In reply to Re^2: My first pTk megawidget
by Anonymous Monk
in thread My first pTk megawidget
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |