#!/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 => 'black', # 'blue', 
                             #-font => 30,
                           )->pack(-fill => 'x');

my $lbox;
    


  my $entry = $frame->Entry(
                             -textvariable => \$search,
                             -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
                             #                          },
                          )->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




my $header_msg = "ENTER Archive name: ";

my $mw = MainWindow->new;
# $mw->geometry( '+900+250' );
$mw->title(
            ' '  ## " " must be specified for a plain frame
      );

my $lb = $mw->GUIask( -text => $header_msg,
            )->pack(-fill => 'both', -expand => 1, -side => 'left');



MainLoop;

[download]

I LEARNED SOMETHING. The widget was working correctly. I was confused because the top window (in this case $mw) was the same size as the widget GRRRRRR. NOW, how do I get the entered data back? To test what I was doing, I had to use a stripped down GUI from another program I am working on. But to make it display the way I want, I needed to put the widget between: $dialog = $top -> DialogBox ( -title => 'Select Database', -buttons => [] ); . . . $top = $dialog -> Show(); Is there a better way to do this?

In reply to Re^7: My first pTk megawidget by Anonymous Monk
in thread My first pTk megawidget by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.