#!/usr/bin/perl --
use strict;
use warnings;
#~ use Gtk3 '-init';
#~ my $windowclass = 'Gtk3::Window';
#~ my $entryclass = 'Gtk3::Entry';
#~ my $quitclass = 'Gtk3';
#~ my $box = Gtk3::Box->new('vertical', 5);
#~ my $bufferclass = 'Gtk3::EntryBuffer';
use Gtk2 '-init';
my $windowclass = 'Gtk2::Window';
my $entryclass = 'Gtk2::Entry';
my $quitclass = 'Gtk2';
my $bufferclass = 'Gtk2::EntryBuffer';
my $box = Gtk2::VBox->new;
##
my $bufferentry = $bufferclass->new;
my $uff = $bufferclass->new;
tie my $foo, 'TraceBuffer', $uff, "foo text";
my $bar = TraceBuffer->new( $bufferentry, "bar text" );
$foo = "sha nana ";
$bar->STORE("tra la la ");
my $window = $windowclass->new();
$window->set_title('EntryBuffer');
$window->signal_connect('destroy' => sub {$quitclass->main_quit});
$window->add($box);
my $ent = $entryclass->new();
$ent->set_buffer($uff);
$box->add($ent);
my $entry = $entryclass->new();
$entry->set_buffer($bufferentry);
$box->add($entry);
$window->show_all();
$quitclass->main();
BEGIN {
package TraceBuffer;
sub new {
my $pkg = shift;
$pkg->TIESCALAR(@_);
}
sub TIESCALAR {
my $class = shift;
my $buffer = shift || die "USELESS WITHOUT BUFFER!\n";
my $text = shift || '';
$buffer->set_text( $text );
return bless [ $buffer, $text ] => $class;
}
sub FETCH {
#~ return $_[0]->[0]->get_text();
return $_[0]->[1];
}
sub STORE {
$_[0]->[1] = $_[1];
$_[0]->[0]->set_text( $_[1] );
}
sub DESTROY {
undef @{$_[0]};
}
$INC{'TraceBuffer.pm'} = __FILE__;
1;;
}
Its only half of it, if user updates the entry, the "tracebuffer" doesn't know about it ... you'd have to involve https://metacpan.org/pod/Glib::Object::Subclass for that portion |