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

This is as far as I can get. Why is it I can get LabEntry to return the entered-string, but I cant do so with my widget? I am trying to modify LabEntry because I use this block-of-code/widget a lot. It also needs an ABORT/QUIT button so the user can back-out/cancel.

#!/usr/pkg/bin/perl use strict; use warnings; use diagnostics; use Tk; use Tk::DialogBox; use Tk::Frame; { ## OPEN package package Tk::GUIask; use List::Util qw(first); use base qw/Tk::Frame /; Construct Tk::Widget 'GUIask'; ## INSTALL MyNewWidget in pTk names +pace sub ClassInit ## Called once to intitalise new class { my ($class , $mw ) = @_; $class ->SUPER::ClassInit($mw); } sub Populate { my ($self , $args ) = @_; $self ->SUPER::Populate($args) ; require Tk::Entry; $self -> SUPER::Populate($args); ## NEEDED? my $search = ""; my $frame = $self -> Frame( -borderwidth => 5, -relief => 'ridge', ) -> pack(); my $label = $frame -> Label ( -fg => 'blue', -font => 30 ) -> pack(-fill => 'x' ); my $entry = $frame -> Entry() -> pack(-fill => 'x'); my $button = $frame -> Button ( -background => 'Red', -text => "Abort", -command => sub { ($frame -> destroy() ) if Tk::Exi +sts($frame); } ) -> pack ( -side => 'top', -fill => 'x', ); $self -> Advertise ('entry' => $frame ); $self -> ConfigSpecs ( DEFAULT => [$frame], text => [$label] ## IF ID DONT have the string ' +text => [$label]' ); ## then it will choke on '-text + => $header_msg' ## WHY? $self -> Delegates ( DEFAULT => $frame ); } ## CLOSE Populate 1; } ## CLOSE package ######################################################### ######################################################### ## Invoke the MEGAWIDGET down here to test ## my $mw = MainWindow -> new; $mw -> geometry('+900+250'); $mw -> title(' '); my $header_msg ="FOOOOO"; my $input; my $dialog = $mw ->DialogBox( -title => ' ', -buttons => [] ); my $entry = $dialog -> GUIask( # -text => $header_msg, -textvariable => \$input, -label => $header_msg #-label => "FOOOO" )-> pack(); $dialog -> bind( <'KeyPress-Return'> , sub { print "\$input =: $input\n + "; # my $text = $entry -> get(); $dialog -> destroy(); } ); MainLoop;

Replies are listed 'Best First'.
Re: Building an adaptable 'Entry Widget'
by tybalt89 (Monsignor) on Feb 21, 2022 at 02:03 UTC
    #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11141523 use warnings; use Tk; use Tk::DialogBox; use Tk::Frame; { ## OPEN package package Tk::GUIask; use List::Util qw(first); use base qw/Tk::Frame /; Construct Tk::Widget 'GUIask'; ## INSTALL MyNewWidget in pTk namespace sub ClassInit ## Called once to intitalise new class { my ($class , $mw ) = @_; $class ->SUPER::ClassInit($mw); } sub Populate { my ($self , $args ) = @_; my $tv = delete $args->{-textvariable}; # NOTE $self ->SUPER::Populate($args) ; require Tk::Entry; # $self -> SUPER::Populate($args); ## NEEDED? my $search = ""; my $frame = $self -> Frame( -borderwidth => 5, -relief => 'ridge', ) -> pack(); my $label = $frame -> Label ( -fg => 'blue', -font => 30 ) -> pack(-fill => 'x' ); my $entry = $frame -> Entry( -textvariable => $tv, # NOTE ) -> pack(-fill => 'x'); my $button = $frame -> Button ( -background => 'Red', -text => "Abort", -command => sub { ($frame -> destroy() ) if Tk::Exists($frame); } ) -> pack ( -side => 'top', -fill => 'x',); $self -> Advertise ('entry' => $frame ); $self -> ConfigSpecs ( DEFAULT => [$frame], text => [$label] ## IF ID DONT have the string 'text => [$labe +l]' ); ## then it will choke on '-text => $header_m +sg' ## WHY? $self -> Delegates ( DEFAULT => $frame, bind => $entry, # NOTE ); } ## CLOSE Populate 1; } ## CLOSE package ## Invoke the MEGAWIDGET down here to test ## my $mw = MainWindow -> new; $mw -> geometry('300x300+900+250'); $mw -> title('Main Window '); my $header_msg ="FOOOOO"; my $input = ''; my $dialog = $mw ->DialogBox( -title => ' ', -buttons => []); my $entry = $dialog -> GUIask( -textvariable => \$input, -label => $header_msg )-> pack(); $entry -> bind( '<Return>' , sub # NOTE { print "input = $input\n"; $dialog -> destroy(); } ); $dialog->Show; # NOTE MainLoop;

      THANKS! That was awfully close to my desired goal.

      Inside of:

      sub Populate { ... }
      You have:
      my $entry = $frame -> Entry( -textvariable => $tv, # NOTE ) -> pack(-fill => 'x');
      Why isnt it ' -textvariable => \$tv, ' ?

      When I call widgets inside of DialogBox I do:

      GUIask ( -textvariable => \$input, )
      Why the disconnect/inconsistancy ? I totally dont get this difference.

      #######################################

      Inside of

      sub Populate { }
      you have:
      my $label = $frame -> Label ( -fg => 'blue', -font => 30 ) -> pack(-fill => 'x' );
      Shouldnt the label be inside the frame (and colored blue) ? Because I am not seeing that; this is something I want.

      If I click on the main window, and move it, my widget gets covered up.

      SEE: Writing my first PERL/Tk megawidgit

      This mega-widget does not do that. Why? (Also another Q by me). This mega-widget stuff is new to me.

      It would be nice to have some comments, to make this code more understandable like the

      Entry( -textvariable => $tv, ) -> pack(-fill => 'x');

      block above. (why its not \$tv )

      2022-02-23 Athanasius added code and paragraph tags.

        Where did my structure go?! Is there a way to delete and reformat this?

        It was just a bunch of small code snippets and Qs.

        ANYHOOOOOO, I solved 1 Q, and that brought up another Q:

        When I call GUIask mega-widget, and use ' -label => $header_msg' the $header_msg gets printed outside the Frame(); when I use '-text => $header_msg' then the $header_msg gets printed inside the Frame().

        Why the difference here? The second case ('-text => $header_msg') is what I wanted.

        OH! BTW: I tried to get an acct here. I didnt get an email. I will check Trash, but dont count on it; I have already thrown much stuff out today...

        2022-02-23 Athanasius added code and paragraph tags.

Re: Building an adaptable 'Entry Widget'
by choroba (Cardinal) on Feb 20, 2022 at 22:23 UTC