CreateWOR: Subclassing TextUndo
- Added onChange like callbacks to CreateWOR's text field and text widget. This required subclassing the TextUndo class and properly handling the call back.
Subclassing TextUndo
This is not working exactly as it should. I can't seem to store things like the onChange callback and a scalar representing the contents of the TextUndo widget in the new MyText object. I rely on overriding the methods InsertKeypress, insert, delete and replace in order to trap when modifications are made to the text, changing the $text member and to call the appropriate callback, but the object that's passed in is different than the object as it was in new and member variables for $text and $modified_CB are missing! So instead I use a package global but this means that only one, the same one, $modification_CB is used for all instantiations of MyText and the $text variable doesn't work at all. Instead one must call get_text in the &$modified_CB:
# Subclass TextUndo widget to trap and call subroutine when text changes
package Tk::MyText;
use Tk::TextUndo;
use base qw/Tk::TextUndo/;
Construct Tk::Widget "MyText";
my $modified_CB;
sub new {
my $class = shift;
my $self = shift;
my %parms = @_;
$modified_CB = delete $parms{-modified} if $parms{-modified};
$self->{text} = delete $parms{-text} if $parms{-text};
$class->SUPER::new ($self, %parms);
} # new
sub get_text {
my $self = shift;
return $self->{text};
} # get_text
sub InsertKeypress {
my $self = shift;
$self->SUPER::InsertKeypress (@_);
$self->{text} = $self->get ("1.0", "end");
&$modified_CB ($self) if $modified_CB;
} # InsertKeypress
sub insert {
my $self = shift;
$self->SUPER::insert (@_);
$self->{text} = $self->get ("1.0", "end");
} # insert
sub delete {
my $self = shift;
$self->SUPER::delete (@_);
$self->{text} = $self->get ("1.0", "end");
&$modified_CB ($self) if $modified_CB;
} # delete
sub replace {
my $self = shift;
$self->SUPER::replace (@_);
$self->{text} = $self->get ("1.0", "end");
&$modified_CB ($self) if $modified_CB;
} # replace