1# A few GUI routines for asking the user questions using the Tk library. 2 3package XMLTV::Ask::Tk; 4use strict; 5 6# Use Log::TraceMessages if installed. 7BEGIN { 8 eval { require Log::TraceMessages }; 9 if ($@) { 10 *t = sub {}; 11 *d = sub { '' }; 12 } 13 else { 14 *t = \&Log::TraceMessages::t; 15 *d = \&Log::TraceMessages::d; 16 } 17} 18 19use Tk; 20 21my $main_window; 22my $top_frame; 23my $middle_frame; 24my $bottom_frame; 25my $mid_bottom_frame; 26 27# Ask a question with a free text answer. 28# Parameters: 29# current module 30# question text 31# what character to show instead of the one typed 32# Returns the text entered by the user. 33sub ask( $$$ ) { 34 shift; 35 my $question = shift; 36 my $show = shift; 37 38 my $textbox; 39 40 $main_window = MainWindow->new; 41 42 $main_window->title("Question"); 43 $main_window->minsize(qw(400 250)); 44 $main_window->geometry('+250+150'); 45 46 $top_frame = $main_window->Frame()->pack; 47 $middle_frame = $main_window->Frame()->pack; 48 $bottom_frame = $main_window->Frame()->pack(-side => 'bottom'); 49 50 $top_frame->Label(-height => 2)->pack; 51 52 $top_frame->Label(-text => $question)->pack; 53 54 my $ans; 55 56 $bottom_frame->Button(-text => "OK", 57 -command => sub {$ans = $textbox->get(); $main_window->destroy;}, 58 -width => 10 59 )->pack(-padx => 2, -pady => 4); 60 61 if (defined $show) { 62 $textbox = $middle_frame->Entry(-show => $show)->pack(); 63 } 64 else { 65 $textbox = $middle_frame->Entry()->pack(); 66 } 67 MainLoop(); 68 69 return $ans; 70} 71 72# Ask a question with a password answer. 73# Parameters: 74# current module 75# question text 76# Returns the text entered by the user. 77sub ask_password( $$ ) { ask($_[0], $_[1], "*") } 78 79 80# Ask a question where the answer is one of a set of alternatives. 81# 82# Parameters: 83# current module 84# question text 85# default choice 86# Remaining arguments are the choices available. 87# 88# Returns one of the choices, or undef if input could not be read. 89# 90sub ask_choice( $$$@ ) { 91 shift; 92 my $question = shift; die if not defined $question; 93 my $default = shift; die if not defined $default; 94 my @options = @_; die if not @options; 95 t "asking question $question, default $default"; 96 warn "default $default not in options" 97 if not grep { $_ eq $default } @options; 98 return _ask_choices( $question, $default, 0, @options ); 99} 100 101# Ask a yes/no question. 102# 103# Parameters: 104# current module 105# question text 106# default (true or false) 107# 108# Returns true or false, or undef if input could not be read. 109# 110sub ask_boolean( $$$ ) { 111 shift; 112 my ($text, $default) = @_; 113 t "asking question $text, default $default"; 114 115 $main_window = MainWindow->new; 116 117 $main_window->title('Question'); 118 $main_window->minsize(qw(400 250)); 119 $main_window->geometry('+250+150'); 120 121 $top_frame = $main_window->Frame()->pack; 122 $middle_frame = $main_window->Frame()->pack; 123 $bottom_frame = $main_window->Frame()->pack(-side => 'bottom'); 124 125 $top_frame->Label(-height => 2)->pack; 126 $top_frame->Label(-text => $text)->pack; 127 128 my $ans = 0; 129 130 $bottom_frame->Button(-text => "Yes", 131 -command => sub { $ans = 1; $main_window->destroy; }, 132 -width => 10, 133 )->pack(-side => 'left', -padx => 2, -pady => 4); 134 135 $bottom_frame->Button(-text => "No", 136 -command => sub { $ans = 0; $main_window->destroy; }, 137 -width => 10 138 )->pack(-side => 'left', -padx => 2, -pady => 4); 139 140 MainLoop(); 141 142 return $ans; 143} 144 145# Ask yes/no questions with option 'default to all'. 146# 147# Parameters: 148# current module 149# default (true or false), 150# question texts (one per question). 151# 152# Returns: lots of booleans, one for each question. If input cannot 153# be read, then a partial list is returned. 154# 155sub ask_many_boolean( $$@ ) { 156 shift; 157 my $default=shift; 158 my @options = @_; 159 return _ask_choices('', $default, 1, @options); 160} 161 162# A helper routine used to create the listbox for both 163# ask_choice and ask_many_boolean 164sub _ask_choices( $$$@ ) { 165 my $question=shift; 166 my $default=shift; 167 my $allowedMany=shift; 168 my @options = @_; 169 170 return if not @options; 171 172 my $select_all_button; 173 my $select_none_button; 174 175 my $listbox; 176 my $i; 177 178 $main_window = MainWindow->new; 179 180 $main_window->title('Question'); 181 $main_window->minsize(qw( 400 250 )); 182 $main_window->geometry('+250+150'); 183 184 $top_frame = $main_window->Frame()->pack; 185 $middle_frame = $main_window->Frame()->pack(-fill => 'both'); 186 187 $top_frame->Label(-height => 2)->pack; 188 189 $top_frame->Label(-text => $question)->pack; 190 191 $listbox = $middle_frame->ScrlListbox(); 192 193 $listbox->insert(0, @options); 194 195 if ($allowedMany) { 196 $listbox->configure( -selectmode => 'multiple' ); 197 198 if ($default) { 199 $listbox->selectionSet( 0, 'end' ); 200 } 201 202 $mid_bottom_frame = $main_window->Frame()->pack(); 203 204 $select_all_button = $mid_bottom_frame->Button 205 (-text => 'Select All', 206 -command => sub { $listbox->selectionSet(0, 1000) }, 207 -width => 10, 208 )->pack(-side => 'left'); 209 210 $select_none_button = $mid_bottom_frame->Button 211 (-text => 'Select None', 212 -command => sub { $listbox->selectionClear(0, 1000) }, 213 -width => 10, 214 )-> pack(-side => 'right'); 215 } 216 else { 217 $listbox->configure(-selectmode => 'single'); 218 $listbox->selectionSet(_index_array($default, @options)); 219 } 220 221 $listbox->pack(-fill => 'x', -padx => '5', -pady => '2'); 222 223 $bottom_frame = $main_window->Frame()->pack(-side => 'bottom'); 224 225 my @cursel; 226 227 $bottom_frame->Button(-text => 'OK', 228 -command => sub { @cursel = $listbox->curselection; $main_window->destroy; }, 229 -width => 10, 230 )->pack(-padx => 2, -pady => 4); 231 232 MainLoop(); 233 234 if ($allowedMany) { 235 my @choices; 236 my @choice_numbers = @cursel; 237 238 $i=0; 239 foreach (@options) { 240 push @choices, 0; 241 foreach( @choice_numbers ) { 242 if ($options[$_] eq $options[$i]) { 243 $choices[$i] = 1; 244 } 245 } 246 $i++; 247 } 248 249 return @choices; 250 } 251 else { 252 my $ans = $options[$cursel[0]]; 253 return $ans; 254 } 255} 256 257# Give some information to the user 258# Parameters: 259# current module 260# text to show to the user 261sub say( $$ ) { 262 shift; 263 my $question = shift; 264 265 $main_window = MainWindow->new; 266 267 $main_window->title("Information"); 268 $main_window->minsize(qw(400 250)); 269 $main_window->geometry('+250+150'); 270 271 $top_frame = $main_window->Frame()->pack; 272 $middle_frame = $main_window->Frame()->pack; 273 $bottom_frame = $main_window->Frame()->pack(-side => 'bottom'); 274 275 $top_frame->Label(-height => 2)->pack; 276 $top_frame->Label(-text => $question)->pack; 277 278 $bottom_frame->Button(-text => "OK", 279 -command => sub { $main_window->destroy; }, 280 -width => 10, 281 )->pack(-padx => 2, -pady => 4); 282 283 MainLoop(); 284} 285 286# A hekper routine that returns the index in an array 287# of the supplied argument 288# Parameters: 289# the item to find 290# the array to find it in 291# Returns the index of the item in the array, or -1 if not found 292sub _index_array($@) 293{ 294 my $s=shift; 295 my @array = @_; 296 297 for (my $i = 0; $i < $#array; $i++) { 298 return $i if $array[$i] eq $s; 299 } 300 301 return -1; 302} 303 3041; 305