kgsueme/kgsueme/gtk.pl

package gtk;

use Carp;
use File::Temp;
use Gtk2;

our $text_renderer = new Gtk2::CellRendererText;
our $int_renderer  = new Gtk2::CellRendererText;
$int_renderer->set (xalign => 1);

our $state = $util::state->{gtk} ||= {};

# shows the properties of a glib object
sub info {
   my ($idx, $obj) = @_;
   return if $seen{$idx}++;
   print "\n$idx\n";
   for ($obj->list_properties) {
      printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
   }
}

my %get = (
   window_size     => sub { [ ($_[0]->allocation->values)[2,3] ] },
   #window_pos     => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
   column_size     => sub { $_[0]->get("width") || $_[0]->get("fixed_width") },
   modelsortorder  => sub { [ $_[0]->get_sort_column_id ] },
);

my %set = (
   window_size     => sub { $_[0]->set_default_size (@{$_[1]}) },
   #window_pos     => sub { $_[0]->set_uposition (@{$_[1]}) if @{$_[1]} },
   column_size     => sub { $_[0]->set (fixed_width => $_[1]) },
   modelsortorder  => sub { $_[0]->set_sort_column_id (@{$_[1]}) },
);

my %widget;

sub state {
   my ($widget, $class, $instance, %attr) = @_;

   while (my ($k, $v) = each %attr) {
      my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);

      $v = $state->{$class}{"*"}{$get}
         if exists $state->{$class}{"*"} && exists $state->{$class}{"*"}{$get};

      $v = $state->{$class}{$instance}{$get}
         if defined $instance
         && exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};

      $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);

      my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "set $class ($instance) $set => $vx\n";#d#
   }

   #$widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });

   $widget{$widget} = [$widget, $class, $instance, \%attr];
   Scalar::Util::weaken $widget{$widget}[0];
}

sub save_state {
   for (grep $_, values %widget) {
      my ($widget, $class, $instance, $attr) = @$_;

      next unless $widget; # no destroy => widget may be undef

      $widget->realize if $widget->can("realize");

      while (my ($k, $v) = each %$attr) {
         my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
         $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);

         $state->{$class}{"*"}{$get}       = $v;
         $state->{$class}{$instance}{$get} = $v if defined $instance;

         my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "get $class ($instance) $get => $vx\n";#d#
      }
   }
}

# string => Gtk2::Image
sub image_from_data {
   my ($data) = @_;
   
   # need to write to file first :/
   my ($fh, $filename) = File::Temp::tempfile ();
   syswrite $fh, $data;
   close $fh;

   my $img = new_from_file Gtk2::Image $filename;

   unlink $filename;
   
   $img;
}

package gtk::widget;

# hacked gtk pseudo-widget

sub new {
   my $class = shift;
   bless { @_ }, $class;
}

sub widget { $_[0]{widget} }

sub AUTOLOAD {
   $AUTOLOAD =~ /::([^:]+)$/ or Carp::confess "$AUTOLOAD: no such method (illegal name)";
   ref $_[0]{widget} or Carp::confess "AUTOLOAD: non-method call $AUTOLOAD(@_)\n";
   my $method = $_[0]{widget}->can($1)
      or Carp::confess "$AUTOLOAD: no such method";
   # do NOT cache.. we are fats enough this way
   unshift @_, shift->{widget};
   &$method;
}

sub destroy {
   my ($self) = @_;
   warn "destroy($self)";#d#

   for (keys %$self) {
      (delete $self->{$_})->destroy
         if UNIVERSAL::can ($self->{$_}, "destroy");
#         if (UNIVERSAL::isa ($self->{$_}, Glib::Object)
#             && UNIVERSAL::isa ($self->{$_}, gtk::widget))
#            && $self->{$_}->can("destroy");
   }
}

sub DESTROY {
   my ($self) = @_;
   warn "DESTROY($self)";#d#
}

package gtk::text;

use base gtk::widget;

sub new {
   my $class = shift;
   my $self = $class->SUPER::new(@_);

   $self->{buffer} = new Gtk2::TextBuffer undef;

   $self->{widget} = new Gtk2::ScrolledWindow;
   $self->{widget}->set_policy("never", "always");

   $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
   $self->{view}->set_wrap_mode ("word");

   $self->set_end;

   $self;
}

sub set_end {
   my ($self) = @_;

   # this is probably also a hack...
   $self->{idle} ||= add Glib::Idle sub {
      $self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
         if $self->{view};
      delete $self->{idle};
   };
}

sub at_end {
   my ($self) = @_;

   my $adj = $self->{widget}->get_vadjustment;
   # this is, maybe, a bad hack :/
   warn $adj->value . "+" . $adj->page_size . ">= ". $adj->upper;
   $adj->value + $adj->page_size >= $adj->upper - 0.5;
}

sub append_text {
   my ($self, $text) = @_;

   my $at_end = $self->at_end;

   $self->{buffer}->insert ($self->{buffer}->get_end_iter, $text);

   $self->set_end if $at_end;
}

sub set_text {
   my ($self, $text) = @_;

   my $at_end = $self->at_end;
           
   $self->{buffer}->set_text ("");
   $self->append_text ($text);

   $self->set_end if $at_end;
}

1;

Revision:	1.16
Committed:	Sun Jun 1 20:12:13 2003 UTC (21 years ago) by pcg
Content type:	text/plain
Branch:	MAIN
Changes since 1.15:	+34 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	package gtk;
2
3	pcg	1.3	use Carp;
4	pcg	1.15	use File::Temp;
5			use Gtk2;
6	pcg	1.3
7	pcg	1.1	our $text_renderer = new Gtk2::CellRendererText;
8			our $int_renderer = new Gtk2::CellRendererText;
9			$int_renderer->set (xalign => 1);
10
11	pcg	1.5	our $state = $util::state->{gtk} \|\|= {};
12	pcg	1.1
13			# shows the properties of a glib object
14	pcg	1.3	sub info {
15	pcg	1.1	my ($idx, $obj) = @_;
16	pcg	1.5	return if $seen{$idx}++;
17	pcg	1.1	print "\n$idx\n";
18			for ($obj->list_properties) {
19			printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
20			}
21			}
22
23			my %get = (
24			window_size => sub { [ ($_[0]->allocation->values)[2,3] ] },
25			#window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
26	pcg	1.5	column_size => sub { $_[0]->get("width") \|\| $_[0]->get("fixed_width") },
27	pcg	1.10	modelsortorder => sub { [ $_[0]->get_sort_column_id ] },
28	pcg	1.1	);
29
30			my %set = (
31	pcg	1.8	window_size => sub { $_[0]->set_default_size (@{$_[1]}) },
32			#window_pos => sub { $_[0]->set_uposition (@{$_[1]}) if @{$_[1]} },
33			column_size => sub { $_[0]->set (fixed_width => $_[1]) },
34	pcg	1.10	modelsortorder => sub { $_[0]->set_sort_column_id (@{$_[1]}) },
35	pcg	1.1	);
36
37	pcg	1.5	my %widget;
38
39	pcg	1.1	sub state {
40			my ($widget, $class, $instance, %attr) = @_;
41
42			while (my ($k, $v) = each %attr) {
43			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
44	pcg	1.9
45			$v = $state->{$class}{"*"}{$get}
46			if exists $state->{$class}{""} && exists $state->{$class}{""}{$get};
47
48			$v = $state->{$class}{$instance}{$get}
49			if defined $instance
50			&& exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};
51
52	pcg	1.1	$set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
53	pcg	1.9
54			my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "set $class ($instance) $set => $vx\n";#d#
55	pcg	1.1	}
56
57	pcg	1.8	#$widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });
58	pcg	1.1
59	pcg	1.5	$widget{$widget} = [$widget, $class, $instance, \%attr];
60			Scalar::Util::weaken $widget{$widget}[0];
61	pcg	1.1	}
62
63			sub save_state {
64	pcg	1.5	for (grep $_, values %widget) {
65			my ($widget, $class, $instance, $attr) = @$_;
66
67	pcg	1.8	next unless $widget; # no destroy => widget may be undef
68
69	pcg	1.5	$widget->realize if $widget->can("realize");
70
71			while (my ($k, $v) = each %$attr) {
72			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
73			$v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
74
75			$state->{$class}{"*"}{$get} = $v;
76			$state->{$class}{$instance}{$get} = $v if defined $instance;
77	pcg	1.9
78			my $vx = KGS::Listener::Debug::dumpval $v; $vx =~ s/\s+/ /g; warn "get $class ($instance) $get => $vx\n";#d#
79	pcg	1.1	}
80			}
81	pcg	1.15	}
82
83			# string => Gtk2::Image
84			sub image_from_data {
85			my ($data) = @_;
86
87			# need to write to file first :/
88			my ($fh, $filename) = File::Temp::tempfile ();
89			syswrite $fh, $data;
90			close $fh;
91
92			my $img = new_from_file Gtk2::Image $filename;
93
94			unlink $filename;
95
96			$img;
97	pcg	1.1	}
98
99	pcg	1.2	package gtk::widget;
100
101			# hacked gtk pseudo-widget
102
103	pcg	1.3	sub new {
104			my $class = shift;
105			bless { @_ }, $class;
106			}
107
108	pcg	1.2	sub widget { $_[0]{widget} }
109
110			sub AUTOLOAD {
111	pcg	1.3	$AUTOLOAD =~ /::([^:]+)$/ or Carp::confess "$AUTOLOAD: no such method (illegal name)";
112	pcg	1.5	ref $_[0]{widget} or Carp::confess "AUTOLOAD: non-method call $AUTOLOAD(@_)\n";
113	pcg	1.3	my $method = $_[0]{widget}->can($1)
114			or Carp::confess "$AUTOLOAD: no such method";
115			# do NOT cache.. we are fats enough this way
116			unshift @_, shift->{widget};
117			&$method;
118			}
119
120	pcg	1.5	sub destroy {
121			my ($self) = @_;
122	pcg	1.14	warn "destroy($self)";#d#
123	pcg	1.12
124	pcg	1.5	for (keys %$self) {
125			(delete $self->{$_})->destroy
126	pcg	1.13	if UNIVERSAL::can ($self->{$_}, "destroy");
127			# if (UNIVERSAL::isa ($self->{$_}, Glib::Object)
128			# && UNIVERSAL::isa ($self->{$_}, gtk::widget))
129			# && $self->{$_}->can("destroy");
130	pcg	1.5	}
131			}
132
133			sub DESTROY {
134			my ($self) = @_;
135	pcg	1.14	warn "DESTROY($self)";#d#
136	pcg	1.5	}
137
138	pcg	1.3	package gtk::text;
139
140			use base gtk::widget;
141
142			sub new {
143			my $class = shift;
144			my $self = $class->SUPER::new(@_);
145
146			$self->{buffer} = new Gtk2::TextBuffer undef;
147
148	pcg	1.16	$self->{widget} = new Gtk2::ScrolledWindow;
149			$self->{widget}->set_policy("never", "always");
150	pcg	1.3
151	pcg	1.16	$self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
152			$self->{view}->set_wrap_mode ("word");
153
154			$self->set_end;
155	pcg	1.6
156	pcg	1.3	$self;
157			}
158
159	pcg	1.16	sub set_end {
160			my ($self) = @_;
161
162			# this is probably also a hack...
163			$self->{idle} \|\|= add Glib::Idle sub {
164			$self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
165			if $self->{view};
166			delete $self->{idle};
167			};
168			}
169
170			sub at_end {
171			my ($self) = @_;
172
173			my $adj = $self->{widget}->get_vadjustment;
174			# this is, maybe, a bad hack :/
175			warn $adj->value . "+" . $adj->page_size . ">= ". $adj->upper;
176			$adj->value + $adj->page_size >= $adj->upper - 0.5;
177			}
178
179	pcg	1.4	sub append_text {
180	pcg	1.5	my ($self, $text) = @_;
181
182	pcg	1.16	my $at_end = $self->at_end;
183
184	pcg	1.5	$self->{buffer}->insert ($self->{buffer}->get_end_iter, $text);
185	pcg	1.16
186			$self->set_end if $at_end;
187	pcg	1.4	}
188
189	pcg	1.3	sub set_text {
190			my ($self, $text) = @_;
191	pcg	1.4
192	pcg	1.16	my $at_end = $self->at_end;
193
194	pcg	1.5	$self->{buffer}->set_text ("");
195			$self->append_text ($text);
196	pcg	1.16
197			$self->set_end if $at_end;
198	pcg	1.1	}
199
200			1;
201