There is no problem with DialogBox, an it allows you to make up really complex dialogs.

I attached a piece of code here, and it is a big chunk, but it is some real code I am using. It is highly OO'd. I believe that it shows you most of the things you want and how to deliver them in Tk.

package OpenRemoteFile;

use VisitedHosts;
use Net::FTP;
use Tk::DialogBox;
use File::Temp qw/:POSIX/;
use IO::Socket::INET;

use Hash::Util (lock_keys);

use strict;
use warnings;


sub new {
    my $self = {};
    shift;
    $self->{PARENT_WIDGET} = shift;
    $self->{HOST} = undef;
    $self->{USER} = undef;
    $self->{PASSWD} = undef;
    $self->{VISITED_HOSTS} = new VisitedHosts;
    $self->{DIRECTORY} = undef;
    $self->{FILE} = undef;
    $self->{CURRENT_FTP_SESSION} = undef;
    $self->{DATA} = [];
    $self->{DEBUG} = 1;
    bless($self);
    return $self;
}

sub Show {
    my $self = shift;
    $self->{HOST} = undef;
    $self->{FILE} = undef;
    $self->clean();
    $self->{CURRENT_FTP_SESSION} = undef;
    my $continueinue = 1;

    $continueinue = $self->host_dialog();
    if ($continueinue) {
        $continueinue = $self->login_dialog();
    }
        
    if ($continueinue) {
        $continueinue = $self->file_dialog();
    }
    return $continueinue;
}

sub host_dialog {
    my $self = shift;
    my $continueinue = 1;
    my $host_first_try = 1;

    while (1) {
        my $host_dialog = $self->{PARENT_WIDGET}->DialogBox(-buttons =
+> ["OK", "Cancel"],
                                                            -title => 
+"Open Remote File");
        my $instruction;
        if ($host_first_try) {
            $instruction = "Please specify host name: ";
            $host_first_try = 0;
        } else {
            $instruction = "Failed to connect, please try again: "
        }

        $host_dialog->add("Label",
                          anchor => "w",
                          text => $instruction)
                    ->pack(fill => "x");
        my $host_text = $host_dialog->add("Entry",
                                          width => 30)
                                    ->pack();
        my $host_list = $host_dialog->add("Listbox", 
                                           height => 5)
                                    ->pack(fill => "x");
        $host_list->bind("<Double-Button-1>", 
                         sub {
                              my $sel_index = $host_list->curselection
+();
                              if (defined($sel_index)) {
                                  $host_text->delete("1.0", "end");
                                  $host_text->insert("end", $host_list
+->get($sel_index));
                              }
                             });
        my @visited_hosts = sort $self->{VISITED_HOSTS}->all_visited()
+;
        foreach (@visited_hosts) {
            $host_list->insert("end", $_);
        }
        $host_text->focus();
        if ($host_dialog->Show() eq "OK") {
            $self->{HOST} = $host_text->get();
            last if ($self->{CURRENT_FTP_SESSION} = new Net::FTP($self
+->{HOST}));
        } else {
            $continueinue = 0;
            last;
        }
    }
    return $continueinue;
}

sub login_dialog {
    my $self = shift;

    my $continueinue = 1;
    my $login_first_try = 1;    
    my $visited;
    my $id;
    my $passwd;

    if ($visited = $self->{VISITED_HOSTS}->visited($self->{HOST})) {
        $id = $visited->userid();
        $passwd = $visited->passwd();
        $self->{CURRENT_FTP_SESSION}->login($id, $passwd);
    } else {
        while (1) {
            my $dialog = $main::self->{MAIN_WINDOW}
                                    ->DialogBox(-buttons => ["OK", "Ca
+ncel"],
                                                -title => "Login");
            my $instruction;
            if ($login_first_try) {
                $instruction = "Please provide id/passwd: ";
                $login_first_try = 0;
            } else {
                $instruction = "Failed to login, please try again: "
            }

            $dialog->add("Label",
                              anchor => "w",
                              text => $instruction)
                        ->pack(fill => "x");
            my $id_text = $dialog->add("Entry",
                                              width => 30)
                                        ->pack();
            my $passwd_text = $dialog->add("Entry",
                                           show => "*",
                                           width => 30)
                                     ->pack();
            $id_text->focus();
            if ($dialog->Show() eq "OK") {
                $id = $id_text->get();
                $passwd = $passwd_text->get();
                if ($self->{CURRENT_FTP_SESSION}->login($id, $passwd))
+ {
                    $self->{DIRECTORY} = $self->{CURRENT_FTP_SESSION}-
+>pwd();
                    if (!$visited) {
                        $self->{VISITED_HOSTS}->add($self->{HOST}, $id
+, $passwd);
                        $self->{USER} = $id;
                        $self->{PASSWD} = $passwd;
                    }
                    last;
                }
            } else {
                $continueinue = 0;
                last;
            }
        }
    }

    return $continueinue;
}

sub file_dialog {
    my $self = shift;
    my $dialog = $self->{PARENT_WIDGET}
                      ->DialogBox(-buttons => ["OK", "Cancel"],
                                  -title => "Open File");
    $dialog->add("Label",
                 anchor => "w",
                 text => "Host: $self->{HOST}")
           ->pack(fill => "x");
    my $label = $dialog->add("Label",
                             anchor => "w",
                             textvariable => \$self->{DIRECTORY})
                       ->pack(fill => "x"); 
    my $file_list = $dialog->add("Scrolled",
                                 "Listbox",
                                 -scrollbars => "e", 
                                 height => 10,
                                 width => 40)
                           ->pack(fill => "x");
    $file_list->bind("<Double-Button-1>", 
                     sub {
                          $self->display_file_list($file_list, $label)
+;
                         });
    $label->configure("text", $self->{CURRENT_FTP_SESSION}->pwd());
    $self->update_file_list($file_list);
    my $sel_file;
    if ($dialog->Show() eq "OK") {
        my $sel_index = $file_list->curselection();
print "\nsel_index = $sel_index\n";
        if (defined($sel_index)) {
            $self->{FILE} = $file_list->get($sel_index);
print $self->{FILE};
        }
        if (defined($self->{FILE})) {
            $self->open_remote();
        }
    } 
    $self->{CURRENT_FTP_SESSION}->quit();
}

sub update_file_list {
    my ($self, $file_list) = @_;
    my @files = sort($self->{CURRENT_FTP_SESSION}->ls());
    $file_list->delete(0, "end");
    $file_list->insert("end", "..");
    for my $name (@files) {
        $file_list->insert("end", $name);
    }
}

sub display_file_list {
    my ($self, $file_list, $label) = @_;

    my $sel_index = $file_list->curselection();
    if (defined($sel_index)) {
        my $sel = $file_list->get($sel_index);
        if ($self->{CURRENT_FTP_SESSION}->cwd($sel)) {
            $self->update_file_list($file_list);
            $self->{DIRECTORY} = $self->{CURRENT_FTP_SESSION}->pwd();
        } else {
            $self->{FILE} = $sel;
            $self->{CURRENT_FTP_SESSION}->get($self->{FILE});
        }
    } 
}    

sub host {
    my $self = shift;
    return $self->{HOST};
}

sub directory {
    my $self = shift;
    return $self->{DIRECTORY};
}

sub tmp_file {
    my $self = shift;
    return $self->{FILE};
}

sub clean {
    my $self = shift;
    if (defined($self->{TMP_FILE})) {
        unlink($self->{TMP_FILE});
        $self->{TMP_FILE} = undef;
    }
}

sub data {
    my $self = shift;
    return $self->{DATA};
}

sub open_remote {

    my $self = shift;

    my $ftp = new Net::FTP($self->{HOST}, Debug => 1);
    $ftp->login("peip", "930612jg");
    $ftp->cwd($self->{DIRECTORY});
    my $data;
    open(LOCALFILE, ">", "abc") || die "failed";
    print LOCALFILE "abcd1234";
    print "==$self->{FILE}==\n";
    $ftp->get($self->{FILE}, \*LOCALFILE);
    $ftp->quit();
    close(LOCALFILE);
    print $data;
    @{$self->{DATA}} = split(/\n/, $data);
=document
    my $continue = 1;
    
    my $ftp = new IO::Socket::INET(Proto => "tcp", 
                                   PeerAddr => $self->{HOST}, 
                                   PeerPort => 21, 
                                   Timeout => 60, 
                                   Reuse => 1);
    if (!$ftp) {
        $continue = 0;
        print "Failed to new control socket\n" if ($self->{DEBUG});
    }

    if ($continue) {
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^220/);
    }

    if ($continue) {
        print $ftp "USER $self->{USER}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^331/);
    }

    if ($continue) {
        print $ftp "PASS $self->{PASSWD}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^230/);
    }

    if ($continue) {
        print $ftp "CWD $self->{DIRECTORY}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^250/);
    }

    my $data_l;
    my $data;
    if ($continue) {
        $data_l = new IO::Socket::INET(Proto => "tcp", 
                                       LocalPort => $ftp->sockport(), 
                                       Listen => 1, 
                                       Timeout => 60, 
                                       Reuse => 1);
        if (!$data_l) {
            $continue = 0;
            print "Failed to new data socket\n" if ($self->{DEBUG});
        }
    }

    if ($continue) {
        print $ftp "RETR $self->{FILE}\r\n";
        $data = $data_l->accept();
        close($data_l);
        if (!$data) {
            print "failed to accept data connection\n" if ($self->{DEB
+UG});
            $continue = 0;
        } else {
            my $response = <$ftp>;
            print $response if ($self->{DEBUG});
            @{$self->{DATA}} = <$data>;
            close($data);
            $response = <$ftp>;
            print $response if ($self->{DEBUG});
        }
    }

    if ($ftp) {
        print $ftp "QUIT\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        close($ftp);
    }
=cut
}

1;

[download]

In reply to Re: popup values in Tk by pg
in thread popup values in Tk by eoin

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.