File Coverage

blib/lib/App/Devel/MAT/Explorer/GTK/Widgets.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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;