http://qs321.pair.com?node_id=11118871


in reply to Re^2: Writing my first PERL/Tk megawidgit
in thread Writing my first PERL/Tk megawidgit

I have the MEGAWIDGET displayed in my program. It is floating in the middle of a large text window -- called with 'DialogBox' and 'Show' . How do I get the data out of the Listbox (which is inside the MEGAWIDGET), so I can operate on it? This is my program-code -- as far as I have got: 

                                         my $header_msg = "Get what fr
+om MemCache?" ;

******** BEGIN DialogBox ********        my $dialog = $top -> DialogBo
+x (
                                                                      
+        -title    => ' ',
                                                                      
+        -buttons  => []
                                                                      
+      );


                                         my $lb = $dialog -> ListBox3(
                                                                      
+ -text => $header_msg,

                                                                     )
+ -> pack(-side => 'top'  );
                                                                      
+        
                                                 
                                                $lb -> insert( 'end' ,
+ @cache_list  );


                                                $dialog ->  Button (
                                                                    -t
+ext  => "Abort" ,
                                                                    -b
+g    => 'red' ,
                                                                    -c
+ommand => sub { ( $dialog -> destroy() ) if Tk::Exists( $dialog ) ; }

                                                                  )-> 
+pack ( -side => 'bottom' , -fill => 'x' );

                                            

                                                 $lb -> bind ( '<Doubl
+e-3>' , sub {  
                                                                      
+              my $mychoice = $lb -> get( 'active');
                                                                      
+              print "\$mychoice = : $mychoice\n\n   ";
                                                                      
+            }
                                                             );



 ******** SHOW 'DialogBox ********              $top = $dialog -> Show
+(); 
                                                                      
+    

                                              
                                            #    $lb -> bind('<Double-
+3>' , \&get_choice);


                                                 $lb -> bind ( '<Doubl
+e-3>' , sub {

[download]

Replies are listed 'Best First'.
Re^4: Writing my first PERL/Tk megawidgit
by tybalt89 (Monsignor) on Jul 03, 2020 at 20:53 UTC 
    #!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11118320
use warnings;
use Tk;

{ # start package
package Tk::ListBox3;

use List::Util qw( first );
use base qw/ Tk::Frame /;     # Frame-based composite
Construct Tk::Widget 'ListBox3'; # install MyNewWidget in pTk namespac
+e

sub Populate                # called to build each widget instance
  {
  my($self, $args) = @_;
  $self->SUPER::Populate($args);

  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 = $frame->Scrolled(Listbox => -scrollbars => 'se',
    -height => 20,
    -selectforeground => 'orange',
    -selectbackground => 'steelblue4',
    -exportselection => 0,
    )->pack(-side => 'bottom', -fill => 'both', -expand=> 1);
  $frame->Entry(
    -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
      },
    )->pack(-fill => 'x');

  $self->ConfigSpecs( DEFAULT => [$lbox], text => [$label],);

  $self->Delegates( Construct => $lbox, insert => $lbox, get => $lbox 
+);
  }

} # end package


my @choices = sort qw /alpha beta charlie delta echo foxtrot hotel ind
+ia juliet
  kilo lima motel nancy oscar papa quebec radio sierra tango uniform v
+ictor
  whiskey xray yankee zulu oin gloin beorn gandalf elr ond eowyn/;
my $header_msg = "ENTER a KEY name: ";
my $selection;

my $mw = MainWindow->new;
$mw->geometry( '+900+250' );
$mw->title( 'Listbox' );

my $lb = $mw->ListBox3( -text => $header_msg,
  )->pack(-fill => 'both', -expand => 1,);
$lb->insert( 'end', @choices );

$mw->Button(-text => 'QUIT', -bg => 'red', -command => sub {
  $selection = $lb->get('active');
  $mw->destroy
  },
  )->pack(-fill => 'x');

MainLoop;

defined $selection and print "'$selection' was selected\n";

    [download]
[reply]
[d/l]

      Oops, active is different from curselection 

      #!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11118320
use warnings;
use Tk;

{ # start package
package Tk::ListBox3;

use List::Util qw( first );
use base qw/ Tk::Frame /;     # Frame-based composite
Construct Tk::Widget 'ListBox3'; # install MyNewWidget in pTk namespac
+e

sub Populate                # called to build each widget instance
  {
  my($self, $args) = @_;
  $self->SUPER::Populate($args);

  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 = $frame->Scrolled(Listbox => -scrollbars => 'se',
    -height => 20,
    -selectforeground => 'orange',
    -selectbackground => 'steelblue4',
    -exportselection => 0,
    )->pack(-side => 'bottom', -fill => 'both', -expand=> 1);
  $frame->Entry(
    -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
      },
    )->pack(-fill => 'x');

  $self->ConfigSpecs( DEFAULT => [$lbox], text => [$label],);

  $self->Delegates( Construct => $lbox, insert => $lbox,
    get => $lbox, curselection => $lbox );
  }

} # end package


my @choices = sort qw /alpha beta charlie delta echo foxtrot hotel ind
+ia juliet
  kilo lima motel nancy oscar papa quebec radio sierra tango uniform v
+ictor
  whiskey xray yankee zulu oin gloin beorn gandalf elr ond eowyn/;
my $header_msg = "ENTER a KEY name: ";
my $selection;

my $mw = MainWindow->new;
$mw->geometry( '+900+250' );
$mw->title( 'Listbox' );

my $lb = $mw->ListBox3( -text => $header_msg,
  )->pack(-fill => 'both', -expand => 1,);
$lb->insert( 'end', @choices );

$mw->Button(-text => 'QUIT', -bg => 'red', -command => sub {
  $selection = $lb->get($lb->curselection);
  $mw->destroy
  },
  )->pack(-fill => 'x');

MainLoop;

defined $selection and print "'$selection' was selected\n";

      [download]
[reply]
[d/l]

        That version made more sense. If I split the MEGAWIDGET and save it as a *pm file, and call it, it works fine. It returns the key that was chosen. When I stick it in the program I am working on, it fails... It displays the widget and data, but the line below fails to execute. 

        MainLoop;

defined $selection and print "'$selection' was selected\n";

        [download]

        Here you print '$selection' after 'MainLoop;' In the program. all the GUI stuff is in a subroutine called 'create_ui', which is executed after 'MainLoop;'. Will this mess anything up? An idea here? Anyways, I been learning a lot during this adventure -- thanks.

[reply]
[d/l]

In Section Seekers of Perl Wisdom