summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/ColorDialog.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Tk/ColorDialog.pm58
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;