home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / interactive_gtk.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  5.7 KB  |  242 lines
  1. package interactive_gtk;
  2.  
  3.  
  4.  
  5.  
  6.  
  7. @ISA = qw(interactive);
  8.  
  9. use interactive;
  10. use common qw(:common :functional);
  11. use my_gtk qw(:helpers :wrappers);
  12.  
  13. 1;
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22. sub exit { 
  23.     c::_exit($_[0]) 
  24. }
  25.  
  26. sub ask_from_listW {
  27.     my ($o, $title, $messages, $l, $def) = @_;
  28.     my $r;
  29.  
  30.     my $w = my_gtk->new(first(deref($title)), %$o);
  31.     $w->{retval} = $def || $l->[0]; 
  32.     if (@$l < 5) {
  33.     my $defW;
  34.     my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
  35.     gtkadd($w->{window},
  36.            gtkpack(create_box_with_title($w, @$messages),
  37.                gtkadd(@$l < 3 && sum(map { length $_ } @$l) < 60 ? create_hbox() : create_vbox(),
  38.                   map {
  39.                   my $b = new Gtk::Button($_);
  40.                   $b->signal_connect(clicked => [ $f, $_ ]);
  41.                   $_ eq $def and $defW = $b;
  42.                   $b;
  43.                   } @$l),
  44.                ),
  45.            );
  46.     $defW->grab_focus if $defW;
  47.     $w->{rwindow}->set_position('center') if $::isStandalone;
  48.     $r = $w->main;
  49.     } else {
  50.     $w->_ask_from_list($title, $messages, $l, $def);
  51.     $r = $w->main;
  52.     }
  53.     $r or die "ask_from_list cancel";
  54. }
  55.  
  56. sub ask_many_from_list_refW($$$$$) {
  57.     my ($o, $title, $messages, $list, $val) = @_;
  58.     my $w = my_gtk->new('', %$o);
  59.     my $box = gtkpack(new Gtk::VBox(0,0),
  60.     map_index {
  61.         my $i = $::i;
  62.         my $o = Gtk::CheckButton->new($_);
  63.         $o->set_active(${$val->[$i]});
  64.         $o->signal_connect(clicked => sub { invbool \${$val->[$i]} });
  65.         $o;
  66.     } @$list);
  67.     gtkadd($w->{window},
  68.        gtkpack_(create_box_with_title($w, @$messages),
  69.            1, @$list > 11 ? gtkset_usize(createScrolledWindow($box), 0, 250) : $box,
  70.            0, $w->create_okcancel,
  71.           )
  72.       );
  73.     $w->{ok}->grab_focus;
  74.     $w->main && $val;
  75. }
  76.  
  77.  
  78. sub ask_from_entries_refW {
  79.     my ($o, $title, $messages, $l, $val, %hcallback) = @_;
  80.     my ($title_, @okcancel) = deref($title);
  81.     my $ignore = 0; 
  82.  
  83.     my $w = my_gtk->new($title_, %$o);
  84.     
  85.     my @widgets = map {
  86.     if ($_->{type} eq "list") {
  87.         my $w = new Gtk::Combo;
  88.         $w->set_use_arrows_always(1);
  89.         $w->entry->set_editable(!$_->{not_edit});
  90.         $w->set_popdown_strings(@{$_->{list}});
  91.         $w->disable_activate;
  92.         $_->{val} ||= $_->{list}[0];
  93.         $w;
  94.     } elsif ($_->{type} eq "bool") {
  95.         my $w = Gtk::CheckButton->new($_->{text});
  96.         $w->set_active(${$_->{val}});
  97.         my $i = $_; $w->signal_connect(clicked => sub { $ignore or invbool \${$i->{val}} });
  98.         $w;
  99.     } else {
  100.         new Gtk::Entry;
  101.     }
  102.     } @{$val};
  103.     my $ok = $w->create_okcancel(@okcancel);
  104.  
  105.     sub widget {
  106.     my ($w, $ref) = @_;
  107.     ($ref->{type} eq "list" && @{$ref->{list}}) ? $w->entry : $w
  108.     }
  109.     my @updates = mapn {
  110.     my ($w, $ref) = @_;
  111.     sub {
  112.         $ref->{type} eq "bool" and return;
  113.         ${$ref->{val}} = widget($w, $ref)->get_text;
  114.     };
  115.     } \@widgets, $val;
  116.  
  117.     my @updates_inv = mapn {
  118.     my ($w, $ref) = @_;
  119.     sub { 
  120.         $ref->{type} eq "bool" ? 
  121.           $w->set_active(${$ref->{val}}) :
  122.           widget($w, $ref)->set_text(${$ref->{val}})
  123.     };
  124.     } \@widgets, $val;
  125.  
  126.  
  127.     for (my $i = 0; $i < @$l; $i++) {
  128.     my $ind = $i; 
  129.     my $widget = widget($widgets[$i], $val->[$i]);
  130.     my $changed_callback = sub {
  131.         return if $ignore; 
  132.         &{$updates[$ind]};
  133.         if ($hcallback{changed}) {
  134.         &{$hcallback{changed}}($ind);
  135.         #update all the value
  136.         $ignore = 1;
  137.         &$_ foreach @updates_inv;
  138.         $ignore = 0;
  139.         };
  140.     };
  141.     if ($hcallback{focus_out}) {
  142.         my $focusout_callback = sub {
  143.         return if $ignore;
  144.         &{$hcallback{focus_out}}($ind);
  145.         #update all the value
  146.         $ignore = 1;
  147.         &$_ foreach @updates_inv;
  148.         $ignore = 0;
  149.         };
  150.         $widget->signal_connect(focus_out_event => $focusout_callback);
  151.     }
  152.     if (ref $widget eq "Gtk::Entry") {
  153.         $widget->signal_connect(changed => $changed_callback);
  154.         my $go_to_next = sub {
  155.         if ($ind == $#$l) {
  156.             @$l == 1 ? $w->{ok}->clicked : $w->{ok}->grab_focus();
  157.         } else {
  158.             widget($widgets[$ind+1],$val->[$ind+1])->grab_focus();
  159.         }
  160.         };
  161.         $widget->signal_connect(activate => $go_to_next);
  162.         $widget->signal_connect(key_press_event => sub {
  163.         my ($w, $e) = @_;
  164.         
  165.         
  166.         $w->signal_emit_stop("key_press_event") if chr($e->{keyval}) eq "\x8d";
  167.         });
  168.         $widget->set_text(${$val->[$i]{val}})  if ${$val->[$i]{val}};
  169.         $widget->set_visibility(0) if $val->[$i]{hidden};
  170.     }
  171.     &{$updates[$i]};
  172.     }
  173.  
  174.     my @entry_list = mapn { [($_[0], $_[1])]} $l, \@widgets;
  175.  
  176.     gtkadd($w->{window},
  177.        gtkpack(
  178.            create_box_with_title($w, @$messages),
  179.            create_packtable({}, @entry_list),
  180.            $ok
  181.            ));
  182.     widget($widgets[0],$val->[0])->grab_focus();
  183.     if ($hcallback{complete}) {
  184.     my $callback = sub {
  185.         my ($error, $focus) = &{$hcallback{complete}};
  186.         
  187.         $ignore = 1;
  188.         foreach (@updates_inv) { &{$_};}
  189.         $ignore = 0;
  190.         if ($error) {
  191.         $focus ||= 0;
  192.         widget($widgets[$focus], $val->[$focus])->grab_focus();
  193.         } else {
  194.         return 1;
  195.         }
  196.     };
  197.     #$w->{ok}->signal_connect(clicked => $callback)
  198.     $w->main($callback);
  199.     } else {
  200.     $w->main();
  201.     }
  202. }
  203.  
  204.  
  205. sub wait_messageW($$$) {
  206.     my ($o, $title, $messages) = @_;
  207.  
  208.     my $w = my_gtk->new($title, %$o, grab => 1);
  209.     my $W = pop @$messages;
  210.     gtkadd($w->{window},
  211.        gtkpack(new Gtk::VBox(0,0),
  212.            @$messages,
  213.            $w->{wait_messageW} = new Gtk::Label($W)));
  214.     $w->{rwindow}->set_position('center') if $::isStandalone;
  215.     $w->{wait_messageW}->signal_connect(expose_event => sub { $w->{displayed} = 1 });
  216.     $w->sync until $w->{displayed};
  217.     $w;
  218. }
  219. sub wait_message_nextW {
  220.     my ($o, $messages, $w) = @_;
  221.     $w->{displayed} = 0;
  222.     $w->{wait_messageW}->set(join "\n", @$messages);
  223.     $w->flush until $w->{displayed};
  224. }
  225. sub wait_message_endW {
  226.     my ($o, $w) = @_;
  227.     $w->destroy;
  228. }
  229.  
  230. sub kill {
  231.     my ($o) = @_;
  232.     $o->{before_killing} ||= 0;
  233.  
  234.     while (my $e = shift @tempory::objects) { $e->destroy }
  235.     while (@interactive::objects > $o->{before_killing}) {
  236.     my $w = pop @interactive::objects;
  237.     $w->destroy;
  238.     }
  239.     @my_gtk::grabbed = ();
  240.     $o->{before_killing} = @interactive::objects;
  241. }
  242.