File Coverage

blib/lib/Ask/Gtk.pm
Criterion Covered Total %
statement 12 14 85.7
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 17 19 89.4


line stmt bran cond sub pod time code
1 3     3   1405 use 5.008008;
  3         12  
2 3     3   19 use strict;
  3         53  
  3         73  
3 3     3   16 use warnings;
  3         6  
  3         159  
4              
5             package Ask::Gtk;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.014';
9              
10 3     3   15 use Moo;
  3         6  
  3         13  
11 3     3   1751 use Gtk2 -init;
  0            
  0            
12             use Path::Tiny 'path';
13             use namespace::autoclean;
14              
15             with 'Ask::API';
16              
17             sub is_usable {
18             my ( $self ) = @_;
19             return !!$ENV{'DISPLAY'};
20             }
21              
22             sub info {
23             my ( $self, %o ) = @_;
24            
25             $o{messagedialog_type} ||= 'info';
26             $o{messagedialog_buttons} ||= 'ok';
27            
28             my $msg = Gtk2::MessageDialog->new(
29             undef,
30             [qw/ modal destroy-with-parent /],
31             $o{messagedialog_type},
32             $o{messagedialog_buttons},
33             exists $o{title} ? $o{title} : $o{text},
34             );
35            
36             $msg->set_property( 'secondary-text', $o{text} ) if exists $o{title};
37            
38             return $msg->run;
39             } #/ sub info
40              
41             sub warning {
42             my ( $self, %o ) = @_;
43             $self->info(
44             messagedialog_type => 'warning', messagedialog_buttons => 'close',
45             %o
46             );
47             }
48              
49             sub error {
50             my ( $self, %o ) = @_;
51             $self->info(
52             messagedialog_type => 'error', messagedialog_buttons => 'close',
53             %o
54             );
55             }
56              
57             sub question {
58             my ( $self, %o ) = @_;
59             'yes' eq $self->info(
60             messagedialog_type => 'question',
61             messagedialog_buttons => 'yes-no',
62             %o,
63             );
64             }
65              
66             sub entry {
67             my ( $self, %o ) = @_;
68            
69             my $return;
70            
71             my $dialog = Gtk2::Dialog->new(
72             ( $o{title} || 'Message' ),
73             undef,
74             [qw/ modal destroy-with-parent /],
75             'gtk-ok' => 'none',
76             );
77            
78             if ( defined $o{text} ) {
79             my $label = Gtk2::Label->new( $o{text} );
80             $dialog->vbox->add( $label );
81             }
82            
83             my $entry = Gtk2::Entry->new;
84             $dialog->vbox->add( $entry );
85             $entry->set_text( $o{entry_text} || '' );
86             $entry->select_region( 0, length $entry->get_text );
87             $entry->set_visibility( !$o{hide_text} );
88            
89             my $done = sub {
90             $return = $entry->get_text;
91             $dialog->destroy;
92             Gtk2->main_quit;
93             };
94            
95             $entry->signal_connect( activate => $done );
96             $dialog->signal_connect( response => $done );
97            
98             $dialog->show_all;
99             Gtk2->main;
100             return $return;
101             } #/ sub entry
102              
103             sub file_selection {
104             my ( $self, %o ) = @_;
105             my @return;
106            
107             require URI;
108            
109             my $dialog = Gtk2::FileChooserDialog->new(
110             ( $o{title} || $o{text} || 'File selection' ),
111             undef,
112             $o{directory} ? 'select-folder' : $o{save} ? 'save' : 'open',
113             'gtk-ok' => 'none',
114             );
115            
116             $dialog->set_select_multiple( !!$o{multiple} );
117            
118             my $done = sub {
119             @return = map path( 'URI'->new( $_ )->file ), $dialog->get_uris;
120             $dialog->destroy;
121             Gtk2->main_quit;
122             };
123            
124             $dialog->signal_connect( response => $done );
125            
126             $dialog->show;
127             Gtk2->main;
128            
129             $o{multiple} ? @return : $return[0];
130             } #/ sub file_selection
131              
132             sub _choice {
133             my ( $self, %o ) = @_;
134            
135             my $return;
136            
137             my $dialog = Gtk2::Dialog->new(
138             ( $o{title} || 'Choose' ),
139             undef,
140             [qw/ modal destroy-with-parent /],
141             'gtk-ok' => 'none',
142             );
143            
144             if ( defined $o{text} ) {
145             my $label = Gtk2::Label->new( $o{text} );
146             $dialog->vbox->add( $label );
147             }
148            
149             my $tree_store = Gtk2::TreeStore->new( qw/Glib::String/ );
150             for my $choice ( @{ $o{choices} } ) {
151             my $iter = $tree_store->append( undef );
152             $tree_store->set( $iter, 0 => $choice->[1] );
153             }
154             my $tree_view = Gtk2::TreeView->new( $tree_store );
155             my $tree_column = Gtk2::TreeViewColumn->new();
156             $tree_column->set_title( "Choices" );
157             my $renderer = Gtk2::CellRendererText->new;
158             $tree_column->pack_start( $renderer, 0 );
159             $tree_column->add_attribute( $renderer, text => 0 );
160             $tree_view->append_column( $tree_column );
161             $dialog->vbox->set_size_request( 300, 300 );
162             $dialog->vbox->add( $tree_view );
163             $tree_view->get_selection->set_mode( $o{_tree_mode} || 'single' );
164            
165             my @return;
166             my $done = sub {
167             $tree_view->get_selection->selected_foreach(
168             sub {
169             my ( $i ) = $_[1]->get_indices;
170             push @return, $o{choices}[$i][0];
171             }
172             );
173             $dialog->destroy;
174             Gtk2->main_quit;
175             };
176            
177             $dialog->signal_connect( response => $done );
178            
179             $dialog->show_all;
180             Gtk2->main;
181             return @return;
182             } #/ sub _choice
183              
184             sub multiple_choice {
185             my ( $self, %o ) = @_;
186             $o{title} ||= 'Choose';
187             $o{_tree_mode} = 'multiple';
188             return $self->_choice( %o );
189             }
190              
191             sub single_choice {
192             my ( $self, %o ) = @_;
193             $o{title} ||= 'Choose one';
194             $o{_tree_mode} = 'single';
195             my ( $r ) = $self->_choice( %o );
196             return $r;
197             }
198              
199             1;
200              
201             __END__