summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl39
1 files changed, 39 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl
new file mode 100644
index 00000000000..5062afa0fad
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/choosedir.pl
@@ -0,0 +1,39 @@
+# This demonstration script prompts the user to select a directory.
+
+use vars qw/$TOP/;
+
+sub choosedir {
+ my $demo = shift;
+
+ $TOP = $MW->WidgetDemo
+ (
+ -name => $demo,
+ -text => "Enter a directory name in the entry box or click on the \"Browse\" buttons to select a directory name using the directory selection dialog.",
+ -title => 'Choose Directory Demonstration',
+ -iconname => 'choosedir',
+ );
+ {
+ my $f = $TOP->Frame;
+ my $lab = $f->Label(-text => "Select a directory to open: ",
+ -anchor => 'e');
+ my $ent = $f->Entry(-width => 20);
+ my $but = $f->Button(-text => "Browse ...",
+ -command => sub { dirDialog($TOP, $ent)});
+ $lab->pack(-side => 'left');
+ $ent->pack(-side => 'left',-expand => 'yes', -fill => 'x');
+ $but->pack(-side => 'left');
+ $f->pack(-fill => 'x', -padx => '1c', -pady => 3);
+ }
+}
+
+sub dirDialog {
+ my $w = shift;
+ my $ent = shift;
+ my $dir;
+ $dir = $w->chooseDirectory;
+ if (defined $dir and $dir ne '') {
+ $ent->delete(0, 'end');
+ $ent->insert(0, $dir);
+ $ent->xview('end');
+ }
+}