diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm b/Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm new file mode 100755 index 00000000000..7b62eeca356 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm @@ -0,0 +1,58 @@ +package Tk::ColorDialog; +require Tk::Toplevel; +use base qw(Tk::Toplevel); + +use vars qw($VERSION); +$VERSION = '4.014'; + +Construct Tk::Widget 'ColorDialog'; + +sub Accept +{ + my $cw = shift; + $cw->withdraw; + $cw->{'done'} = 1; +} + +sub Cancel +{ + my $cw = shift; +# $cw->configure(-color => undef); + $cw->configure(-color => 'cancel'); + $cw->Accept; +} + +sub Populate +{ + my ($cw,$args) = @_; + $cw->SUPER::Populate($args); + $cw->protocol('WM_DELETE_WINDOW' => [ 'Cancel' => $cw ]); + $cw->transient($cw->Parent->toplevel); + $cw->withdraw; + my $sel = $cw->ColorSelect; + my $accept = $cw->Button(-text => 'Accept', -command => ['Accept', $cw]); + my $cancel = $cw->Button(-text => 'Cancel', -command => ['Cancel', $cw]); + Tk::grid($sel); + Tk::grid($accept,$cancel); + $cw->ConfigSpecs(DEFAULT => [$sel]); +} + +sub Show +{ + my $cw = shift; + $cw->configure(@_) if @_; + $cw->Popup(); + $cw->OnDestroy(sub { $cw->{'done'} = 0 }); # auto-cancel + $cw->waitVariable(\$cw->{'done'}); + if (Tk::Exists($cw)) + { + $cw->withdraw; + $cw->cget('-color'); + } + else + { + undef; + } +} + +1; |