line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2016 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package App::Devel::MAT::Explorer::GTK::Widgets; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
3285
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
44
|
|
9
|
1
|
|
|
1
|
|
9
|
use warnings; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
76
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.04'; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
300
|
use Glib qw( TRUE FALSE ); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Gtk2; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use List::Util qw( pairs ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use Exporter 'import'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
21
|
|
|
|
|
|
|
framed |
22
|
|
|
|
|
|
|
label |
23
|
|
|
|
|
|
|
textarea |
24
|
|
|
|
|
|
|
vscrollable |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
27
|
|
|
|
|
|
|
all => [ @EXPORT_OK ], |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub framed |
31
|
|
|
|
|
|
|
{ |
32
|
|
|
|
|
|
|
my ( $widget ) = @_; |
33
|
|
|
|
|
|
|
my $frame = Gtk2::Frame->new; |
34
|
|
|
|
|
|
|
$frame->set_shadow_type( "in" ); |
35
|
|
|
|
|
|
|
$frame->add( $widget ); |
36
|
|
|
|
|
|
|
return $frame; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub label |
40
|
|
|
|
|
|
|
{ |
41
|
|
|
|
|
|
|
my ( $text ) = @_; |
42
|
|
|
|
|
|
|
my $l = Gtk2::Label->new( $text ); |
43
|
|
|
|
|
|
|
$l->set_alignment( 0, 0 ); |
44
|
|
|
|
|
|
|
return $l; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub textarea |
48
|
|
|
|
|
|
|
{ |
49
|
|
|
|
|
|
|
my ( $text ) = @_; |
50
|
|
|
|
|
|
|
my $l = label( $text ); |
51
|
|
|
|
|
|
|
$l->set_selectable( TRUE ); |
52
|
|
|
|
|
|
|
$l->set_can_focus( FALSE ); |
53
|
|
|
|
|
|
|
return $l; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub vscrollable |
57
|
|
|
|
|
|
|
{ |
58
|
|
|
|
|
|
|
my ( $widget ) = @_; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $win = Gtk2::ScrolledWindow->new; |
61
|
|
|
|
|
|
|
$win->set_policy( 'never', 'always' ); |
62
|
|
|
|
|
|
|
$win->add( $widget ); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
return $win; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub Devel::MAT::UI::make_table |
68
|
|
|
|
|
|
|
{ |
69
|
|
|
|
|
|
|
shift; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $table = Gtk2::Table->new( 1, 2 ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
foreach ( pairs @_ ) { |
74
|
|
|
|
|
|
|
my ( $label, $widget ) = @$_; |
75
|
|
|
|
|
|
|
my ( $next_row ) = $table->get_size; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$table->attach( label( $label ), 0, 1, $next_row, $next_row + 1, [ "expand", "fill" ], [ "fill" ], 0, 3 ); |
78
|
|
|
|
|
|
|
$table->attach( $widget, 1, 2, $next_row, $next_row + 1, [ "expand", "fill" ], [ "fill" ], 0, 3 ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
return $table; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub Devel::MAT::UI::make_widget_text |
85
|
|
|
|
|
|
|
{ |
86
|
|
|
|
|
|
|
shift; |
87
|
|
|
|
|
|
|
my ( $text ) = @_; |
88
|
|
|
|
|
|
|
return textarea( $text ); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub Devel::MAT::UI::make_widget_text_icon |
92
|
|
|
|
|
|
|
{ |
93
|
|
|
|
|
|
|
my $self = shift; |
94
|
|
|
|
|
|
|
my ( $label, $icon ) = @_; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
my $hbox = Gtk2::HBox->new; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
$hbox->add( $self->make_widget_text( $label ) ); |
99
|
|
|
|
|
|
|
$hbox->add( Gtk2::Image->new_from_pixbuf( get_icon( $icon ) ) ); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
return $hbox; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
0x55AA; |