| 1 | package gtk; |
1 | package gtk; |
|
|
2 | |
|
|
3 | use Carp; |
| 2 | |
4 | |
| 3 | our $text_renderer = new Gtk2::CellRendererText; |
5 | our $text_renderer = new Gtk2::CellRendererText; |
| 4 | our $int_renderer = new Gtk2::CellRendererText; |
6 | our $int_renderer = new Gtk2::CellRendererText; |
| 5 | $int_renderer->set (xalign => 1); |
7 | $int_renderer->set (xalign => 1); |
| 6 | |
8 | |
| 7 | our $state = $util::state->{gtk} || {}; |
9 | our $state = $util::state->{gtk} || {}; |
| 8 | |
10 | |
| 9 | # shows the properties of a glib object |
11 | # shows the properties of a glib object |
| 10 | sub gtk_info { |
12 | sub info { |
| 11 | my ($idx, $obj) = @_; |
13 | my ($idx, $obj) = @_; |
| 12 | last if $seen{$idx}++; |
14 | last if $seen{$idx}++; |
| 13 | print "\n$idx\n"; |
15 | print "\n$idx\n"; |
| 14 | for ($obj->list_properties) { |
16 | for ($obj->list_properties) { |
| 15 | printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr}; |
17 | printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr}; |
| … | |
… | |
| 97 | |
99 | |
| 98 | package gtk::widget; |
100 | package gtk::widget; |
| 99 | |
101 | |
| 100 | # hacked gtk pseudo-widget |
102 | # hacked gtk pseudo-widget |
| 101 | |
103 | |
|
|
104 | sub new { |
|
|
105 | my $class = shift; |
|
|
106 | bless { @_ }, $class; |
|
|
107 | } |
|
|
108 | |
| 102 | sub widget { $_[0]{widget} } |
109 | sub widget { $_[0]{widget} } |
| 103 | |
110 | |
| 104 | sub AUTOLOAD { |
111 | sub AUTOLOAD { |
| 105 | warn $AUTOLOAD; |
112 | $AUTOLOAD =~ /::([^:]+)$/ or Carp::confess "$AUTOLOAD: no such method (illegal name)"; |
| 106 | die; |
113 | 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 | package gtk::text; |
|
|
121 | |
|
|
122 | use base gtk::widget; |
|
|
123 | |
|
|
124 | sub new { |
|
|
125 | my $class = shift; |
|
|
126 | my $self = $class->SUPER::new(@_); |
|
|
127 | |
|
|
128 | $self->{buffer} = new Gtk2::TextBuffer undef; |
|
|
129 | |
|
|
130 | $self->{widget} = new Gtk2::TextView; |
|
|
131 | |
|
|
132 | $self; |
|
|
133 | } |
|
|
134 | |
|
|
135 | sub set_text { |
|
|
136 | my ($self, $text) = @_; |
| 107 | } |
137 | } |
| 108 | |
138 | |
| 109 | 1; |
139 | 1; |
| 110 | |
140 | |
