Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Below is my perl/pTk code:

#!/usr/bin/perl 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!! { # for package package Tk::GUIask; 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 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 $entry = $frame->Entry( -textvariable => \$search, -validate => 'key', )->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 => [$lbox], text => [$label] ); $self->Delegates( Construct => $lbox, insert => $lbox ); } } # CLOSE package

I wish to add an "Abort" button with a red bg. I can add the button -- but when I click on it, I get an error. This widget will go into a couple programs that pop up the same widget repeatedly, asking for input from the user.

Replies are listed 'Best First'.
Re: My first pTk megawidget
by choroba (Cardinal) on Nov 09, 2021 at 17:55 UTC
    I uncommented the button part and added
    my $mw = 'MainWindow'->new; $mw->GUIask->pack; MainLoop();

    When I click on the red button, the frame disappears. I don't get any errors.

    Please provide more details.

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

      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 your original code, you had the button code in the megawidget, but commented out. I uncommented it and it worked. Please post code we can run to see the problem without having to shuffle parts of it around and guessing.

        map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]