diff options
author | Karl Berry <karl@freefriends.org> | 2005-12-28 00:07:27 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2005-12-28 00:07:27 +0000 |
commit | 30dd9f517c9c093ff3319061647a4555264f7914 (patch) | |
tree | 0d7a349bf99be5a42cc9c5a80a30f3b7136c4ccd /Master/xemtex/perl/site/lib/Tk/Canvas.pm | |
parent | 08ab8dce83f53b0f915cb66a37bbc8478b22c307 (diff) |
trunk
git-svn-id: svn://tug.org/texlive/trunk@9 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/xemtex/perl/site/lib/Tk/Canvas.pm')
-rw-r--r-- | Master/xemtex/perl/site/lib/Tk/Canvas.pm | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/Master/xemtex/perl/site/lib/Tk/Canvas.pm b/Master/xemtex/perl/site/lib/Tk/Canvas.pm new file mode 100644 index 00000000000..e1ce78b6a93 --- /dev/null +++ b/Master/xemtex/perl/site/lib/Tk/Canvas.pm @@ -0,0 +1,60 @@ +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; + |