1package Tk::Text::Tag; 2require Tk::Text; 3 4use overload '""' => \&name; 5 6 7use vars qw($VERSION); 8$VERSION = '4.004'; # $Id: //depot/Tkutf8/Text/Text/Tag.pm#4 $ 9 10sub _apply 11{ 12 my $self = shift; 13 my $meth = shift; 14 $self->widget->tag($meth => $self->name,@_); 15} 16 17sub name 18{ 19 return shift->[0]; 20} 21 22sub widget 23{ 24 return shift->[1]; 25} 26 27BEGIN 28{ 29 my $meth; 30 foreach $meth (qw(cget configure bind add)) 31 { 32 *{$meth} = sub { shift->_apply($meth,@_) } 33 } 34} 35 36sub new 37{ 38 my $class = shift; 39 my $widget = shift; 40 my $name = shift; 41 my $obj = bless [$name,$widget],$class; 42 $obj->configure(@_) if (@_); 43 return $obj; 44} 45 461; 47