diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/ColorEditor.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/ColorEditor.pm | 761 |
1 files changed, 0 insertions, 761 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/ColorEditor.pm b/Master/tlpkg/tlperl/lib/Tk/ColorEditor.pm deleted file mode 100644 index e84b0077410..00000000000 --- a/Master/tlpkg/tlperl/lib/Tk/ColorEditor.pm +++ /dev/null @@ -1,761 +0,0 @@ -package Tk::ColorSelect; -use strict; - -use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/; - -use Tk qw(Ev); - -require Tk::Frame; - -use base qw(Tk::Frame); -Construct Tk::Widget 'ColorSelect'; - -sub Populate -{ - my ($middle,$args) = @_; - my($i, @a); - require Tk::Config; - my(@xlibpath) = map { s/^-L//; "$_/X11/rgb.txt" } - split /\s+/, $Tk::Config::xlib; - foreach $i (@xlibpath, - '/usr/local/lib/X11/rgb.txt', '/usr/lib/X11/rgb.txt', - '/usr/X11R6/lib/X11/rgb.txt', - '/usr/local/X11R5/lib/X11/rgb.txt', '/X11/R5/lib/X11/rgb.txt', - '/X11/R4/lib/rgb/rgb.txt', '/usr/openwin/lib/X11/rgb.txt') { - local *FOO; - next if ! open FOO, $i; - my $middle_left = $middle->Frame; - $middle_left->pack( - -side => 'left', - -padx => '0.25c', - -pady => '0.25c', - ); - my $names = $middle->Listbox( - -width => 20, - -height => 12, - -relief => 'sunken', - -borderwidth => 2, - -exportselection => 0, - ); - - $names->bind('<Double-1>' => [$middle,'color',Ev(['getSelected'])]); - - my $scroll = $middle->Scrollbar( - -orient => 'vertical', - -command => ['yview', $names], - -relief => 'sunken', - -borderwidth => 2, - ); - $names->configure(-yscrollcommand => ['set',$scroll]); - $names->pack(-in => $middle_left, -side => 'left'); - $scroll->pack(-in => $middle_left, -side => 'right', -fill => 'y'); - - while(<FOO>) { - chomp; - next if /^!/; - my @a = split; - my $color = join(' ', @a[3 .. $#a]); - my $hex; - eval { $hex = $middle->Hex($color); }; - if ($@) { - #print STDERR "unknown color: '$color'\n"; - if ($@ =~ /unknown color name "/) { - next; - } else { - chomp $@; - die $@; - } - } - if (!exists($Tk::ColorEditor::names{$hex}) || - length($Tk::ColorEditor::names{$hex}) > length($color)) { - $Tk::ColorEditor::names{$hex} = $color; - $names->insert('end', $color); - } - } - close FOO; - last; - } - - # Create the three scales for editing the color, and the entry for typing - # in a color value. - - my $middle_middle = $middle->Frame; - $middle_middle->pack(-side => 'left', -expand => 1, -fill => 'y'); - my $mcm1 = $middle_middle->Optionmenu(-variable => \$middle->{'color_space'}, - -command => [ $middle, 'color_space'], - -relief => 'raised', - -options => [ ['HSB color space' => 'hsb'], - ['RGB color space' => 'rgb'], - ['CMY color space' => 'cmy']]); - $mcm1->pack(-side => 'top', -fill => 'x'); - - my(@middle_middle, @label, @scale); - $middle_middle[0] = $middle_middle->Frame; - $middle_middle[1] = $middle_middle->Frame; - $middle_middle[2] = $middle_middle->Frame; - $middle_middle[3] = $middle_middle->Frame; - $middle_middle[0]->pack(-side => 'top', -expand => 1); - $middle_middle[1]->pack(-side => 'top', -expand => 1); - $middle_middle[2]->pack(-side => 'top', -expand => 1); - $middle_middle[3]->pack(-side => 'top', -expand => 1, -fill => 'x'); - $middle->{'Labels'} = ['zero','one','two']; - foreach $i (0..2) { - $label[$i] = $middle->Label(-textvariable => \$middle->{'Labels'}[$i]); - $scale[$i] = $middle->Scale( - -from => 0, - -to => 1000, - '-length' => '6c', - -orient => 'horizontal', - -command => [\&scale_changed, $middle], - ); - $scale[$i]->pack( - -in => $middle_middle[$i], - -side => 'top', - -anchor => 'w', - ); - $label[$i]->pack( - -in => $middle_middle[$i], - -side => 'top', - -anchor => 'w', - ); - } - my $nameLabel = $middle->Label(-text => 'Name:'); - $middle->{'Entry'} = ''; - my $name = $middle->Entry( - -relief => 'sunken', - -borderwidth => 2, - -textvariable => \$middle->{'Entry'}, - -width => 10, -# For some reason giving this font causes problems at end of t/create.t -# -font => '-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*' - ); - - $nameLabel->pack(-in => $middle_middle[3], -side => 'left'); - $name->pack( - -in => $middle_middle[3], - -side => 'right', - -expand => 1, - -fill => 'x', - ); - $name->bind('<Return>' => [ $middle, 'color', Ev(['get'])]); - - # Create the color display swatch on the right side of the window. - - my $middle_right = $middle->Frame; - $middle_right->pack( - -side => 'left', - -pady => '.25c', - -padx => '.25c', - -anchor => 's', - ); - my $swatch = $middle->Canvas( - -width => '2.5c', - -height => '5c', - ); - my $swatch_item = $swatch->create('oval', '.5c', '.3c', '2.26c', '4.76c'); - - my $value = $middle->Label( - -textvariable => \$middle->{'color'}, - -width => 13, - -font => '-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*' - ); - - $swatch->pack( - -in => $middle_right, - -side => 'top', - -expand => 1, - -fill => 'both', - ); - $value->pack(-in => $middle_right, -side => 'bottom', -pady => '.25c'); - - $middle->ConfigSpecs( - '-color_space' => ['METHOD', undef, undef, 'hsb'], - '-initialcolor' => '-color', - '-color' => ['METHOD', 'background', 'Background', - $middle->cget('-background')] - ); - - $middle->{'swatch'} = $swatch; - $middle->{'swatch_item'} = $swatch_item; - $middle->{'scale'} = [@scale]; - $middle->{'red'} = 0; - $middle->{'blue'} = 0; - $middle->{'green'} = 0; - -} - -sub Hex -{ - my $w = shift; - my @rgb = (@_ == 3) ? @_ : $w->rgb(@_); - sprintf('#%04x%04x%04x',@rgb) -} - -sub color_space { - - my($objref, $space) = @_; - - if (@_ > 1) - { - my %Labels = ( 'rgb' => [qw(Red Green Blue)], - 'cmy' => [qw(Cyan Magenta Yellow)], - 'hsb' => [qw(Hue Saturation Brightness)] ); - - # The procedure below is invoked when a new color space is selected. It - # changes the labels on the scales and re-loads the scales with the - # appropriate values for the current color in the new color space - - $space = 'hsb' unless (exists $Labels{$space}); - my $i; - for $i (0..2) - { - $objref->{'Labels'}[$i] = $Labels{$space}->[$i]; - } - $objref->{'color_space'} = $space; - $objref->afterIdle(['set_scales',$objref]) unless ($objref->{'pending'}++); - } - return $objref->{'color_space'}; -} # color_space - -sub hsvToRgb { - - # The procedure below converts an HSB value to RGB. It takes hue, - # saturation, and value components (floating-point, 0-1.0) as arguments, - # and returns a list containing RGB components (integers, 0-65535) as - # result. The code here is a copy of the code on page 616 of - # "Fundamentals of Interactive Computer Graphics" by Foley and Van Dam. - - my($hue, $sat, $value) = @_; - my($v, $i, $f, $p, $q, $t); - - $v = int(65535 * $value); - return ($v, $v, $v) if $sat == 0; - $hue *= 6; - $hue = 0 if $hue >= 6; - $i = int($hue); - $f = $hue - $i; - $p = int(65535 * $value * (1 - $sat)); - $q = int(65535 * $value * (1 - ($sat * $f))); - $t = int(65535 * $value * (1 - ($sat * (1 - $f)))); - return ($v, $t, $p) if $i == 0; - return ($q, $v, $p) if $i == 1; - return ($p, $v, $t) if $i == 2; - return ($p, $q, $v) if $i == 3; - return ($t, $p, $v) if $i == 4; - return ($v, $p, $q) if $i == 5; - -} # end hsvToRgb - -sub color -{ - my ($objref,$name) = @_; - if (@_ > 1 && defined($name) && length($name)) - { - if ($name eq 'cancel') { - $objref->{color} = undef; - return; - } - my ($format, $shift); - my ($red, $green, $blue); - - if ($name !~ /^#/) - { - ($red, $green, $blue) = $objref->{'swatch'}->rgb($name); - } - else - { - my $len = length $name; - if($len == 4) { $format = '#(.)(.)(.)'; $shift = 12; } - elsif($len == 7) { $format = '#(..)(..)(..)'; $shift = 8; } - elsif($len == 10) { $format = '#(...)(...)(...)'; $shift = 4; } - elsif($len == 13) { $format = '#(....)(....)(....)'; $shift = 0; } - else { - $objref->BackTrace( - "ColorEditor error: syntax error in color name \"$name\""); - return; - } - ($red,$green,$blue) = $name =~ /$format/; - # Looks like a call for 'pack' or similar rather than eval - eval "\$red = 0x$red; \$green = 0x$green; \$blue = 0x$blue;"; - $red = $red << $shift; - $green = $green << $shift; - $blue = $blue << $shift; - } - $objref->{'red'} = $red; - $objref->{'blue'} = $blue; - $objref->{'green'} = $green; - my $hex = sprintf('#%04x%04x%04x', $red, $green, $blue); - $objref->{'color'} = $hex; - $objref->{'Entry'} = $name; - $objref->afterIdle(['set_scales',$objref]) unless ($objref->{'pending'}++); - $objref->{'swatch'}->itemconfigure($objref->{'swatch_item'}, - -fill => $objref->{'color'}); - } - return $objref->{'color'}; -} - -sub rgbToHsv { - - # The procedure below converts an RGB value to HSB. It takes red, green, - # and blue components (0-65535) as arguments, and returns a list - # containing HSB components (floating-point, 0-1) as result. The code - # here is a copy of the code on page 615 of "Fundamentals of Interactive - # Computer Graphics" by Foley and Van Dam. - - my($red, $green, $blue) = @_; - my($max, $min, $sat, $range, $hue, $rc, $gc, $bc); - - $max = ($red > $green) ? (($blue > $red) ? $blue : $red) : - (($blue > $green) ? $blue : $green); - $min = ($red < $green) ? (($blue < $red) ? $blue : $red) : - (($blue < $green) ? $blue : $green); - $range = $max - $min; - if ($max == 0) { - $sat = 0; - } else { - $sat = $range / $max; - } - if ($sat == 0) { - $hue = 0; - } else { - $rc = ($max - $red) / $range; - $gc = ($max - $green) / $range; - $bc = ($max - $blue) / $range; - $hue = ($max == $red)?(0.166667*($bc - $gc)): - (($max == $green)?(0.166667*(2 + $rc - $bc)): - (0.166667*(4 + $gc - $rc))); - } - $hue += 1 if $hue < 0; - return ($hue, $sat, $max/65535); - -} # end rgbToHsv - -sub scale_changed { - - # The procedure below is invoked when one of the scales is adjusted. It - # propagates color information from the current scale readings to - # everywhere else that it is used. - - my($objref) = @_; - - return if $objref->{'updating'}; - my ($red, $green, $blue); - - if($objref->{'color_space'} eq 'rgb') { - $red = int($objref->{'scale'}->[0]->get * 65.535 + 0.5); - $green = int($objref->{'scale'}->[1]->get * 65.535 + 0.5); - $blue = int($objref->{'scale'}->[2]->get * 65.535 + 0.5); - } elsif($objref->{'color_space'} eq 'cmy') { - $red = int(65535 - $objref->{'scale'}->[0]->get * 65.535 + 0.5); - $green = int(65535 - $objref->{'scale'}->[1]->get * 65.535 + 0.5); - $blue = int(65535 - $objref->{'scale'}->[2]->get * 65.535 + 0.5); - } else { - ($red, $green, $blue) = hsvToRgb($objref->{'scale'}->[0]->get/1000.0, - $objref->{'scale'}->[1]->get/1000.0, - $objref->{'scale'}->[2]->get/1000.0); - } - $objref->{'red'} = $red; - $objref->{'blue'} = $blue; - $objref->{'green'} = $green; - $objref->color(sprintf('#%04x%04x%04x', $red, $green, $blue)); - $objref->idletasks; - -} # end scale_changed - -sub set_scales { - - my($objref) = @_; - $objref->{'pending'} = 0; - $objref->{'updating'} = 1; - - # The procedure below is invoked to update the scales from the current red, - # green, and blue intensities. It's invoked after a change in the color - # space and after a named color value has been loaded. - - my($red, $blue, $green) = ($objref->{'red'}, $objref->{'blue'}, - $objref->{'green'}); - - if($objref->{'color_space'} eq 'rgb') { - $objref->{'scale'}->[0]->set(int($red / 65.535 + 0.5)); - $objref->{'scale'}->[1]->set(int($green / 65.535 + 0.5)); - $objref->{'scale'}->[2]->set(int($blue / 65.535 + 0.5)); - } elsif($objref->{'color_space'} eq 'cmy') { - $objref->{'scale'}->[0]->set(int((65535 - $red) / 65.535 + 0.5)); - $objref->{'scale'}->[1]->set(int((65535 - $green) / 65.535 + 0.5)); - $objref->{'scale'}->[2]->set(int((65535 - $blue) / 65.535 + 0.5)); - } else { - my ($s1, $s2, $s3) = rgbToHsv($red, $green, $blue); - $objref->{'scale'}->[0]->set(int($s1 * 1000.0 + 0.5)); - $objref->{'scale'}->[1]->set(int($s2 * 1000.0 + 0.5)); - $objref->{'scale'}->[2]->set(int($s3 * 1000.0 + 0.5)); - } - $objref->{'updating'} = 0; - -} # end set_scales - -package Tk::ColorDialog; -require Tk::Toplevel; -use base qw(Tk::Toplevel); - -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->waitVariable(\$cw->{'done'}); - $cw->withdraw; - return $cw->cget('-color'); -} - -package Tk::ColorEditor; - -use vars qw($VERSION $SET_PALETTE); -$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/; - -use Tk qw(lsearch Ev); -use Tk::Toplevel; -use base qw(Tk::Toplevel); -use Tk::widgets qw(Pixmap); -Construct Tk::Widget 'ColorEditor'; - -%Tk::ColorEditor::names = (); - - -use Tk::Dialog; -use Tk::Pretty; - -BEGIN { $SET_PALETTE = 'Set Palette' }; - -use subs qw(color_space hsvToRgb rgbToHsv); - -# ColorEditor public methods. - -sub add_menu_item -{ - my $objref = shift; - my $value; - foreach $value (@_) - { - if ($value eq 'SEP') - { - $objref->{'mcm2'}->separator; - } - else - { - $objref->{'mcm2'}->command( -label => $value, - -command => [ 'configure', $objref, '-highlight' => $value ] ); - push @{$objref->{'highlight_list'}}, $value; - } - } -} - -sub set_title -{ - my ($w) = @_; - my $t = $w->{Configure}{'-title'} || '' ; - my $h = $w->{Configure}{'-highlight'} || ''; - $w->SUPER::title("$t $h Color Editor"); -} - -sub highlight -{ - my ($w,$h) = @_; - if (@_ > 1) - { - $w->{'update'}->configure( -text => "Apply $h Color" ); - my $state = ($h eq 'background') ? 'normal' : 'disabled'; - $w->{'palette'}->entryconfigure( $SET_PALETTE, -state => $state); - $w->{'highlight'} = $h; - $w->configure(-color => $w->Palette->{$h}); - $w->set_title; - } - return $w->{'highlight'}; -} - -sub title -{ - my ($w,$val) = @_; - $w->set_title if (@_ > 1); - return $w->{Configure}{'-title'}; -} - -sub delete_menu_item -{ - my $objref = shift; - my $value; - foreach $value (@_) - { - $objref->{'mcm2'}->delete($value); - my $list_ord = $value =~ /\d+/ ? $value : lsearch($objref->{'highlight_list'}, $value); - splice(@{$objref->{'highlight_list'}}, $list_ord, 1) if $list_ord != -1; - } -} - -sub delete_widgets { - - # Remove widgets from consideration by the color configurator. - # $widgets_ref points to widgets previously added via `configure'. - - my($objref, $widgets_ref) = @_; - - my($i, $found, $r1, $r2, @wl) = (0, 0, 0, 0, @{$objref->cget(-widgets)}); - foreach $r1 (@{$widgets_ref}) { - $i = -1; - $found = 0; - foreach $r2 (@wl) { - $i++; - next if $r1 != $r2; - $found = 1; - last; - } - splice(@wl, $i, 1) if $found; - } - $objref->configure(-widgets => [@wl]); - -} # end delete_widgets - -sub ApplyDefault -{ - my($objref) = @_; - my $cb = $objref->cget('-command'); - my $h; - foreach $h (@{$objref->{'highlight_list'}}) - { - next if $h =~ /TEAR_SEP|SEP/; - $cb->Call($h); - die unless (defined $cb); - } -} - -sub Populate -{ - - # ColorEditor constructor. - - my($cw, $args) = @_; - - $cw->SUPER::Populate($args); - $cw->withdraw; - - my $color_space = 'hsb'; # rgb, cmy, hsb - my(@highlight_list) = qw( - TEAR_SEP - foreground background SEP - activeForeground activeBackground SEP - highlightColor highlightBackground SEP - selectForeground selectBackground SEP - disabledForeground insertBackground selectColor troughColor - ); - - # Create the Usage Dialog; - - my $usage = $cw->Dialog( '-title' => 'ColorEditor Usage', - -justify => 'left', - -wraplength => '6i', - -text => "The Colors menu allows you to:\n\nSelect a color attribute such as \"background\" that you wish to colorize. Click on \"Apply\" to update that single color attribute.\n\nSelect one of three color spaces. All color spaces display a color value as a hexadecimal number under the oval color swatch that can be directly supplied on widget commands.\n\nApply Tk's default color scheme to the application. Useful if you've made a mess of things and want to start over!\n\nChange the application's color palette. Make sure \"background\" is selected as the color attribute, find a pleasing background color to apply to all current and future application widgets, then select \"Set Palette\".", - ); - - # Create the menu bar at the top of the window for the File, Colors - # and Help menubuttons. - - my $m0 = $cw->Frame(-relief => 'raised', -borderwidth => 2); - $m0->pack(-side => 'top', -fill => 'x'); - my $mf = $m0->Menubutton( - -text => 'File', - -underline => 0, - -bd => 1, - -relief => 'raised', - ); - $mf->pack(-side => 'left'); - my $close_command = [sub {shift->withdraw}, $cw]; - $mf->command( - -label => 'Close', - -underline => 0, - -command => $close_command, - -accelerator => 'Ctrl-w', - ); - $cw->bind('<Control-Key-w>' => $close_command); - $cw->protocol(WM_DELETE_WINDOW => $close_command); - - my $mc = $m0->Menubutton( - -text => 'Colors', - -underline => 0, - -bd => 1, - -relief => 'raised', - ); - $mc->pack(-side => 'left'); - my $color_attributes = 'Color Attributes'; - $mc->cascade(-label => $color_attributes, -underline => 6); - $mc->separator; - - $mc->command( - -label => 'Apply Default Colors', - -underline => 6, - -command => ['ApplyDefault',$cw] - ); - $mc->separator; - $mc->command( - -label => $SET_PALETTE, - -underline => 0, - -command => sub { $cw->setPalette($cw->cget('-color'))} - ); - - my $m1 = $mc->cget(-menu); - - my $mcm2 = $m1->Menu; - $m1->entryconfigure($color_attributes, -menu => $mcm2); - my $mh = $m0->Menubutton( - -text => 'Help', - -underline => 0, - -bd => 1, - -relief => 'raised', - ); - $mh->pack(-side => 'right'); - $mh->command( - -label => 'Usage', - -underline => 0, - -command => [sub {shift->Show}, $usage], - ); - - # Create the Apply button. - - my $bot = $cw->Frame(-relief => 'raised', -bd => 2); - $bot->pack(-side => 'bottom', -fill =>'x'); - my $update = $bot->Button( - -command => [ - sub { - my ($objref) = @_; - $objref->Callback(-command => ($objref->{'highlight'}, $objref->cget('-color'))); - $cw->{'done'} = 1; - }, $cw, - ], - ); - $update->pack(-pady => 1, -padx => '0.25c'); - - # Create the listbox that holds all of the color names in rgb.txt, if an - # rgb.txt file can be found. - - my $middle = $cw->ColorSelect(-relief => 'raised', -borderwidth => 2); - $middle->pack(-side => 'top', -fill => 'both'); - # Create the status window. - - my $status = $cw->Toplevel; - $status->withdraw; - $status->geometry('+0+0'); - my $status_l = $status->Label(-width => 50, -anchor => 'w'); - $status_l->pack(-side => 'top'); - - $cw->{'highlight_list'} = [@highlight_list]; - $cw->{'mcm2'} = $mcm2; - - foreach (@highlight_list) - { - next if /^TEAR_SEP$/; - $cw->add_menu_item($_); - } - - $cw->{'updating'} = 0; - $cw->{'pending'} = 0; - $cw->{'Status'} = $status; - $cw->{'Status_l'} = $status_l; - $cw->{'update'} = $update; - $cw->{'gwt_depth'} = 0; - $cw->{'palette'} = $mc; - - my $pixmap = $cw->Pixmap('-file' => Tk->findINC('ColorEdit.xpm')); - $cw->Icon(-image => $pixmap); - - $cw->ConfigSpecs( - DEFAULT => [$middle], - -widgets => ['PASSIVE', undef, undef, - [$cw->parent->Descendants]], - -display_status => ['PASSIVE', undef, undef, 0], - '-title' => ['METHOD', undef, undef, ''], - -command => ['CALLBACK', undef, undef, ['set_colors',$cw]], - '-highlight' => ['METHOD', undef, undef, 'background'], - -cursor => ['DESCENDANTS', 'cursor', 'Cursor', 'left_ptr'], - ); - -} # end Populate, ColorEditor constructor - -sub Show { - - my($objref, @args) = @_; - - Tk::ColorDialog::Show(@_); - -} # end show - -# ColorEditor default configurator procedure - can be redefined by the -# application. - -sub set_colors { - - # Configure all the widgets in $widgets for attribute $type and color - # $color. If $color is undef then reset all colors - # to the Tk defaults. - - my($objref, $type, $color) = @_; - my $display = $objref->cget('-display_status'); - - $objref->{'Status'}->title("Configure $type"); - $objref->{'Status'}->deiconify if $display; - my $widget; - my $reset = !defined($color); - - foreach $widget (@{$objref->cget('-widgets')}) { - if ($display) { - $objref->{'Status_l'}->configure( - -text => 'WIDGET: ' . $widget->PathName - ); - $objref->update; - } - eval {local $SIG{'__DIE__'}; $color = ($widget->configure("-\L${type}"))[3]} if $reset; - eval {local $SIG{'__DIE__'}; $widget->configure("-\L${type}" => $color)}; - } - - $objref->{'Status'}->withdraw if $display; - -} # end set_colors - -# ColorEditor private methods. - -1; - -__END__ - -=cut - |