Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / Canvas.pm

package Tk::Canvas;
use vars qw($VERSION);
$VERSION = '3.018'; # $Id: //depot/Tk8/Canvas/Canvas.pm#18 $

use Tk qw($XS_VERSION);

use base qw(Tk::Widget);
Construct Tk::Widget 'Canvas';

bootstrap Tk::Canvas;

sub Tk_cmd { \&Tk::canvas }

Tk::Methods('addtag','bbox','bind','canvasx','canvasy','coords','create',
           'dchars','delete','dtag','find','focus','gettags','icursor',
           'index','insert','itemcget','itemconfigure','lower','move',
           'postscript','raise','scale','scan','select','type','xview','yview');

use Tk::Submethods ( 'create' => [qw(arc bitmap grid group image line oval
                                    polygon rectangle text window)],
                    'scan'   => [qw(mark dragto)],
                    'select' => [qw(from clear item to)],
                    'xview'  => [qw(moveto scroll)],
                    'yview'  => [qw(moveto scroll)],
                    );

*CanvasBind  = \&Tk::bind;
*CanvasFocus = \&Tk::focus;

sub ClassInit
{
my ($class,$mw) = @_;
$mw->XYscrollBind($class);
return $class;
}

sub BalloonInfo
{
my ($canvas,$balloon,$X,$Y,@opt) = @_;
my @tags = ($canvas->find('withtag', 'current'),$canvas->gettags('current'));
foreach my $opt (@opt)
 {
  my $info = $balloon->GetOption($opt,$canvas);
  if ($opt =~ /^-(statusmsg|balloonmsg)$/ && UNIVERSAL::isa($info,'HASH'))
   {
    $balloon->Subclient($tags[0]);
    foreach my $tag (@tags)
     {
      return $info->{$tag} if exists $info->{$tag};
     }
    return '';
   }
  return $info;
 }
}



1;