# filebox.tcl --
#
# This demonstration script prompts the user to select a file.
#
# SCCS: @(#) filebox.tcl 1.3 97/03/02 16:22:36
use vars qw/$TOP/;
sub filebox {
    my $demo = shift;
    $TOP = $MW->WidgetDemo
      (
       -name     => $demo,
       -text     => "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog.",
       -title    => 'File box Demonstration',
       -iconname => 'filebox',
      );
    foreach my $i (qw(open save)) {
        my $f = $TOP->Frame;
        my $lab = $f->Label(-text => "Select a file to $i: ",
                            -anchor => 'e');
        my $ent = $f->Entry(-width => 20);
        my $but = $f->Button(-text => "Browse ...",
                             -command => sub { fileDialog($TOP, $ent, $i)});
        $lab->pack(-side => 'left');
        $ent->pack(-side => 'left',-expand => 'yes', -fill => 'x');
        $but->pack(-side => 'left');
        $f->pack(-fill => 'x', -padx => '1c', -pady => 3);
    }
    my $cbf = $TOP->Frame->pack(-fill => 'x', -padx => '1c', -pady => 3);
    my $fd;
    $cbf->Radiobutton
      (-text => 'FileSelect',
       -variable => \$fd,
       -value => 'FileSelect',
       -command => sub { local($^W) = 0;
                         require Tk::FileSelect;
                         Tk::FileSelect->import('as_default');
                         # XXX remove cached dialogs
                         my $mw = $TOP->MainWindow;
                         delete $mw->{'tk_getOpenFile'};
                         delete $mw->{'tk_getSaveFile'};
                     })->pack(-side => 'left');
    my $fdb = $cbf->Radiobutton
      (-text => 'FBox',
       -variable => \$fd,
       -value => 'FBox',
       -command => sub { local($^W) = 0;
                         require Tk::FBox;
                         Tk::FBox->import('as_default');
                         # XXX remove cached dialogs
                         my $mw = $TOP->MainWindow;
                         delete $mw->{'tk_getOpenFile'};
                         delete $mw->{'tk_getSaveFile'};
                     })->pack(-side => 'left');
    $fdb->invoke;
# XXX Motif style file box not implemented
#     unless (compare($tcl_platform{'platform'},'unix'))
#       {
#         $w->{'.strict'} = $w->Checkbutton('Name','strict','-text',"Use Motif Style Dialog",'-variable','tk_strictMotif','-onvalue',1,'-offvalue',0);
#         $w->{'.strict'}->pack('-anchor','c');
#       }
}
sub fileDialog {
    my $w = shift;
    my $ent = shift;
    my $operation = shift;
    my $types;
    my $file;
    #   Type names              Extension(s)    Mac File Type(s)
    #
    #---------------------------------------------------------
    @types =
      (["Text files",           [qw/.txt .doc/]],
       ["Text files",           '',             'TEXT'],
       ["Perl Scripts",         '.pl',          'TEXT'],
       ["C Source Files",       ['.c', '.h']],
       ["All Source Files",     [qw/.tcl .c .h/]],
       ["Image Files",          '.gif'],
       ["Image Files",          ['.jpeg', '.jpg']],
       ["Image Files",          '',             [qw/GIFF JPEG/]],
       ["All files",            '*']
      );
    if ($operation eq 'open') {
        $file = $w->getOpenFile(-filetypes => \@types);
    } else {
        $file = $w->getSaveFile(-filetypes => \@types,
                                -initialfile => 'Untitled',
                                -defaultextension => '.txt');
    }
    if (defined $file and $file ne '') {
        $ent->delete(0, 'end');
        $ent->insert(0, $file);
        $ent->xview('end');
    }
}