package TiedText;
use warnings;
use strict;
require Tk;
require Tk::Text;
require Tk::Frame;

our @ISA= qw(Tk::Frame);
Tk::Widget->Construct("TiedText");

sub Populate{
  my ($self,$args)=@_;
  if (exists ($args->{-variable})){
    $self->{inst_data}{tt_variable}=delete($args->{-variable})
  }
  $self->SUPER::Populate($args);
  my $tw = $self->Text()->pack();
  $tw ->insert('1.0',${$self->{inst_data}{tt_variable}});
  $self->{inst_data}{text_widget}= $tw;
  tie ${$self->{inst_data}{tt_variable}} , 'TiedText' , $self;
  $self->Delegates(DEFAULT=>$tw);
  $self->ConfigSpecs(DEFAULT=>[$tw]);
}


sub TIESCALAR{
  my($class,$self)=@_;
  return $self;
}

sub FETCH{
  my $self = shift;
  my $text =  $self->{inst_data}{text_widget}->get('0.0','end - 1 chars');
  return $text;
}

sub STORE{
  my ($self,$value) = @_;
  $self->{inst_data}{text_widget}->delete('1.0','end');
  $self->{inst_data}{text_widget}->insert('1.0',$value);
}




package main;
 use Tk;
 my $mw = tkinit;
 my $text = 'a teststring ';
 my $t = $mw->Scrolled('TiedText',
                       -wrap       => 'word',
                       -scrollbars => 'oe',
                       -variable => \$text)->pack;
 $mw -> Button (-text => 'print',
                -command => sub {print "$text\n"},
                )->pack;
 $mw -> Button (-text => 'modify',
                -command => sub {$text .= $text},
                )->pack;
 
 MainLoop();