home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / my_gtk.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  14.0 KB  |  563 lines
  1. package my_gtk;
  2.  
  3.  
  4.  
  5.  
  6.  
  7. @ISA = qw(Exporter);
  8. %EXPORT_TAGS = (
  9.     helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title create_treeitem) ],
  10.     wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkpack__ gtkappend gtkadd gtktext_insert gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_background gtkset_default_fontset) ],
  11.     ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ask_file) ],
  12. );
  13. $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
  14. @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
  15.  
  16. use Gtk;
  17. use c;
  18. use common qw(:common :functional);
  19.  
  20. my $forgetTime = 1000; 
  21. $border = 5;
  22.  
  23. 1;
  24.  
  25.  
  26.  
  27.  
  28. sub new {
  29.     my ($type, $title, %opts) = @_;
  30.  
  31.     Gtk->init;
  32.     my $o = bless { %opts }, $type;
  33.     $o->_create_window($title);
  34.     while (my $e = shift @tempory::objects) { $e->destroy }
  35.     push @interactive::objects, $o unless $opts{no_interactive_objects};
  36.  
  37.     top(@grabbed)->grab_remove if @grabbed;
  38.     push(@grabbed, $o->{rwindow}), $o->{rwindow}->grab_add if $my_gtk::grab || $o->{grab};
  39.  
  40.     $o;
  41. }
  42. sub main($;$) {
  43.     my ($o, $f) = @_;
  44.     $o->show;
  45.  
  46.     do {
  47.     local $::setstep = 1;
  48.     Gtk->main
  49.     } while ($o->{retval} && $f && !&$f());
  50.     $o->destroy;
  51.     $o->{retval}
  52. }
  53. sub show($) {
  54.     my ($o) = @_;
  55.     $o->{window}->show;
  56.     $o->{rwindow}->show;
  57. }
  58. sub destroy($) {
  59.     my ($o) = @_;
  60.     (pop @grabbed)->grab_remove if @grabbed;
  61.     top(@grabbed)->grab_add if @grabbed;
  62.     $o->{rwindow}->destroy;
  63.     flush();
  64. }
  65. sub DESTROY { goto &destroy }
  66. sub sync($) {
  67.     my ($o) = @_;
  68.     show($o);
  69.     flush();
  70. }
  71. sub flush(;$) {
  72.     Gtk->main_iteration while Gtk->events_pending;
  73. }
  74. sub bigsize($) {
  75.     $_[0]{rwindow}->set_usize(600,400);
  76. }
  77.  
  78.  
  79. sub gtkshow($)         { $_[0]->show; $_[0] }
  80. sub gtkdestroy($)      { $_[0] and $_[0]->destroy }
  81. sub gtkset_usize($$$)  { $_[0]->set_usize($_[1],$_[2]); $_[0] }
  82. sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
  83. sub gtkset_active($$)  { $_[0]->set_active($_[1]); $_[0] }
  84.  
  85. sub gtksignal_connect($@) {
  86.     my $w = shift;
  87.     $w->signal_connect(@_);
  88.     $w
  89. }
  90. sub gtkpack($@) {
  91.     my $box = shift;
  92.     gtkpack_($box, map { 1, $_} @_);
  93. }
  94. sub gtkpack__($@) {
  95.     my $box = shift;
  96.     gtkpack_($box, map { 0, $_} @_);
  97. }
  98. sub gtkpack_($@) {
  99.     my $box = shift;
  100.     for (my $i = 0; $i < @_; $i += 2) {
  101.     my $l = $_[$i + 1];
  102.     ref $l or $l = new Gtk::Label($l);
  103.     $box->pack_start($l, $_[$i], 1, 0);
  104.     $l->show;
  105.     }
  106.     $box
  107. }
  108. sub gtkappend($@) {
  109.     my $w = shift;
  110.     foreach (@_) {
  111.     my $l = $_;
  112.     ref $l or $l = new Gtk::Label($l);
  113.     $w->append($l);
  114.     $l->show;
  115.     }
  116.     $w
  117. }
  118. sub gtkadd($@) {
  119.     my $w = shift;
  120.     foreach (@_) {
  121.     my $l = $_;
  122.     ref $l or $l = new Gtk::Label($l);
  123.     $w->add($l);
  124.     $l->show;
  125.     }
  126.     $w
  127. }
  128.  
  129. sub gtktext_insert($$) {
  130.     my ($w, $t) = @_;
  131.     $w->backward_delete($w->get_length);
  132.     $w->insert(undef, undef, undef, "$t\n"); 
  133.     $w->set_word_wrap(1);
  134.     $w->vadj->set_value(0);
  135.     $w;
  136. }
  137.  
  138. sub gtkroot {
  139.     Gtk->init;
  140.     Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
  141. }
  142.  
  143. sub gtkcolor($$$) {
  144.     my ($r, $g, $b) = @_;
  145.  
  146.     my $color = bless {}, 'Gtk::Gdk::Color';
  147.     $color->red  ($r);
  148.     $color->green($g);
  149.     $color->blue ($b);
  150.     gtkroot()->get_colormap->color_alloc($color);
  151. }
  152.  
  153. sub gtkset_mousecursor($) {
  154.     my ($type) = @_;
  155.     gtkroot()->set_cursor(Gtk::Gdk::Cursor->new($type));
  156. }
  157.  
  158. sub gtkset_background {
  159.     my ($r, $g, $b) = @_;
  160.  
  161.     my $root = gtkroot();
  162.     my $gc = Gtk::Gdk::GC->new($root);
  163.  
  164.     my $color = gtkcolor($r, $g, $b);
  165.     $gc->set_foreground($color);
  166.     $root->set_background($color);
  167.  
  168.     my ($h, $w) = $root->get_size;
  169.     $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
  170. }
  171.  
  172. sub gtkset_default_fontset($) {
  173.     my ($fontset) = @_;
  174.  
  175.     my $style = Gtk::Widget->get_default_style;
  176.     my $f = Gtk::Gdk::Font->fontset_load($fontset) or die '';
  177.     $style->font($f);
  178.     Gtk::Widget->set_default_style($style);
  179. }
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188. sub create_okcancel($;$$) {
  189.     my ($w, $ok, $cancel) = @_;
  190.  
  191.     gtkadd(create_hbox(),
  192.       gtksignal_connect($w->{ok} = new Gtk::Button($ok || _("Ok")), "clicked" => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk->main_quit }),
  193.       ($ok xor $cancel) ? () : gtksignal_connect(new Gtk::Button($cancel || _("Cancel")), "clicked" => $w->{cancel_clicked} || sub { $w->{retval} = 0; Gtk->main_quit }),
  194.      );
  195. }
  196.  
  197. sub create_box_with_title($@) {
  198.     my $o = shift;
  199.  
  200.     $o->{box} = (@_ <= 2 && (map { split "\n" } @_) > 6) ?
  201.       gtkpack(new Gtk::VBox(0,0),
  202.           gtkset_usize(createScrolledWindow(gtktext_insert(new Gtk::Text, join "\n", @_)), 400, 250)) :
  203.       gtkpack_(new Gtk::VBox(0,0),
  204.            (map {
  205.            my $w = ref $_ ? $_ : new Gtk::Label($_);
  206.            $w->set_name("Title");
  207.            0, $w;
  208.            } map { ref $_ ? $_ : warp_text($_) } @_),
  209.            0, new Gtk::HSeparator,
  210.           );
  211. }
  212.  
  213. sub createScrolledWindow($) {
  214.     my ($W) = @_;
  215.     my $w = new Gtk::ScrolledWindow(undef, undef);
  216.     $w->set_policy('automatic', 'automatic');
  217.     member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text)) ?
  218.       $w->add($W) :
  219.       $w->add_with_viewport($W);
  220.     $W->show;
  221.     $w
  222. }
  223.  
  224. sub create_menu($@) {
  225.     my $title = shift;
  226.     my $w = new Gtk::MenuItem($title);
  227.     $w->set_submenu(gtkshow(gtkappend(new Gtk::Menu, @_)));
  228.     $w
  229. }
  230.  
  231. sub add2notebook {
  232.     my ($n, $title, $book) = @_;
  233.  
  234.     my ($w1, $w2) = map { new Gtk::Label($_) } $title, $title;
  235.     $book->{widget_title} = $w1;
  236.     $n->append_page_menu($book, $w1, $w2);
  237.     $book->show;
  238.     $w1->show;
  239.     $w2->show;
  240. }
  241.  
  242. sub create_notebook(@) {
  243.     my $n = new Gtk::Notebook;
  244.     add2notebook($n, splice(@_, 0, 2)) while @_;
  245.     $n
  246. }
  247.  
  248. sub create_adjustment($$$) {
  249.     my ($val, $min, $max) = @_;
  250.     new Gtk::Adjustment($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1);
  251. }
  252.  
  253. sub create_packtable($@) {
  254.     my $options = shift;
  255.     my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0);
  256.     map_index {
  257.     my ($i) = @_;
  258.     map_index {
  259.         my ($j) = @_;
  260.         if (defined $_) {
  261.         ref $_ or $_ = new Gtk::Label($_);
  262.         $w->attach_defaults($_, $j, $j + 1, $i, $i + 1);
  263.         $_->show;
  264.         }
  265.     } @$_;
  266.     } @_;
  267.     $w->set_col_spacings($options->{col_spacings} || 0);
  268.     $w->set_row_spacings($options->{row_spacings} || 0);
  269.     $w
  270. }
  271.  
  272. sub create_hbox {
  273.     my $w = new Gtk::HButtonBox;
  274.     $w->set_layout(-spread);
  275.     $w;
  276. }
  277. sub create_vbox {
  278.     my $w = new Gtk::VButtonBox;
  279.     $w->set_layout(-spread);
  280.     $w;
  281. }
  282.  
  283.  
  284. sub _create_window($$) {
  285.     my ($o, $title) = @_;
  286.     my $w = new Gtk::Window;
  287.     my $f = new Gtk::Frame(undef);
  288.     $w->set_name("Title");
  289.  
  290.     if ($::isStandalone || $o->{no_border} || 1) { # hack
  291.     gtkadd($w, $f);
  292.     } else {
  293.     my $t = new Gtk::Table(0, 0, 0);
  294.  
  295.     my $new = sub {
  296.         my $w = new Gtk::DrawingArea;
  297.         $w->set_usize($border, $border);
  298.         $w->set_events(['exposure_mask']);
  299.         $w->signal_connect_after(expose_event =>
  300.         sub { $w->window->draw_rectangle($w->style->black_gc, 1, 0, 0, @{$w->allocation}[2,3]); 1 }
  301.         );
  302.         $w->show;
  303.         $w;
  304.     };
  305.  
  306.     $t->attach(&$new(), 0, 1, 0, 3, [],              , ["expand","fill"], 0, 0);
  307.     $t->attach(&$new(), 1, 2, 0, 1, ["expand","fill"], [],                0, 0);
  308.     $t->attach($f,      1, 2, 1, 2, ["expand","fill"], ["expand","fill"], 0, 0);
  309.     $t->attach(&$new(), 1, 2, 2, 3, ["expand","fill"], [],                0, 0);
  310.     $t->attach(&$new(), 2, 3, 0, 3, [],                ["expand","fill"], 0, 0);
  311.  
  312.     gtkadd($w, $t);
  313.     }
  314.  
  315.     $w->set_title($title);
  316.  
  317.     $w->signal_connect(expose_event => sub { c::XSetInputFocus($w->window->XWINDOW); }) if $my_gtk::force_focus || $o->{force_focus};
  318.     $w->signal_connect(delete_event => sub { undef $o->{retval}; Gtk->main_quit });
  319.     $w->set_uposition(@{$my_gtk::force_position || $o->{force_position}}) if $my_gtk::force_position || $o->{force_position};
  320.  
  321.     $w->signal_connect("key_press_event" => sub {
  322.     my $d = ${{ 65481 => 'next',
  323.             65480 => 'previous' }}{$_[1]->{keyval}} or return;
  324.     my $s = $::o->{step};
  325.     do { $s = $::o->{steps}{$s}{$d} } until !$s || $::o->{steps}{$s}{reachable};
  326.     $::setstep && $s and die "setstep $s\n";
  327.     });
  328.  
  329.     $w->signal_connect(size_allocate => sub {
  330.     my ($wi, $he) = @{$_[1]}[2,3];
  331.     my ($X, $Y, $Wi, $He) = @{$my_gtk::force_center || $o->{force_center}};
  332.         $w->set_uposition(max(0, $X + ($Wi - $wi) / 2), max(0, $Y + ($He - $he) / 2));
  333.     }) if ($my_gtk::force_center || $o->{force_center}) && !($my_gtk::force_position || $o->{force_position}) ;
  334.  
  335.     $o->{window} = $f;
  336.     $o->{rwindow} = $w;
  337. }
  338.  
  339. my ($next_child, $left, $right, $up, $down);
  340. {
  341.     my $next_child = sub {
  342.     my ($c, $dir) = @_;
  343.  
  344.     my @childs = $c->parent->children;
  345.    
  346.     my $i; for ($i = 0; $i < @childs; $i++) {
  347.         last if $childs[$i] == $c || $childs[$i]->subtree == $c;
  348.     }
  349.     $i += $dir;
  350.     0 <= $i && $i < @childs ? $childs[$i] : undef;
  351.     };
  352.     $left = sub { &$next_child($_[0]->parent, 0); };
  353.     $right = sub {
  354.     my ($c) = @_;
  355.     if ($c->subtree) {
  356.         $c->expand;
  357.         ($c->subtree->children)[0];
  358.     } else {
  359.         $c;
  360.     }
  361.     };
  362.     $down = sub {
  363.     my ($c) = @_;
  364.     return &$right($c) if ref $c eq "Gtk::TreeItem" && $c->subtree && $c->expanded;
  365.  
  366.     if (my $n = &$next_child($c, 1)) {
  367.         $n;
  368.     } else {
  369.         return if ref $c->parent ne 'Gtk::Tree';    
  370.         &$down($c->parent);
  371.     }
  372.     };
  373.     $up = sub {
  374.     my ($c) = @_;
  375.     if (my $n = &$next_child($c, -1)) {
  376.         $n = ($n->subtree->children)[-1] while ref $n eq "Gtk::TreeItem" && $n->subtree && $n->expanded;
  377.         $n;
  378.     } else {
  379.         return if ref $c->parent ne 'Gtk::Tree';    
  380.         &$left($c);
  381.     }
  382.     };
  383. }
  384.  
  385. sub create_treeitem($) {
  386.     my ($name) = @_;
  387.     
  388.     my $w = new Gtk::TreeItem($name);
  389.     $w->signal_connect(key_press_event => sub {
  390.         my (undef, $e) = @_;
  391.         local $_ = chr ($e->{keyval} & 0xff);
  392.  
  393.     if ($e->{keyval} > 0x100) {
  394.         my $n;
  395.         $n = &$left($w)  if /[Q┤\x96]/;
  396.         $n = &$right($w) if /[S╢\x98]/;
  397.         $n = &$up($w)    if /[R╕\x97]/;
  398.         $n = &$down($w)  if /[T▓\x99]/;
  399.         if ($n) {
  400.         $n->focus('up');
  401.         $w->signal_emit_stop("key_press_event"); 
  402.         }
  403.         $w->expand if /[+½]/;
  404.         $w->collapse if /[-\xad]/;
  405.         do { 
  406.         $w->expanded ? $w->collapse : $w->expand; 
  407.         $w->signal_emit_stop("key_press_event"); 
  408.         } if /[\r\x8d]/;
  409.     }
  410.         1;
  411.     });
  412.     $w;
  413. }
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423. sub ask_warn       { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); }
  424. sub ask_yesorno    { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); }
  425. sub ask_okcancel   { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Is this correct?"), _("Ok"), _("Cancel")); main($w); }
  426. sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); }
  427. sub ask_from_list  { my $w = my_gtk->new($_[0]); $w->_ask_from_list(@_); main($w); }
  428. sub ask_file       { my $w = my_gtk->new(''); $w->_ask_file(@_); main($w); }
  429.  
  430. sub _ask_from_entry($$@) {
  431.     my ($o, @msgs) = @_;
  432.     my $entry = new Gtk::Entry;
  433.     my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit };
  434.     $o->{ok_clicked} = $f;
  435.     $o->{cancel_clicked} = sub { undef $o->{retval}; Gtk->main_quit };
  436.  
  437.     gtkadd($o->{window},
  438.       gtkpack($o->create_box_with_title(@msgs),
  439.          gtksignal_connect($entry, 'activate' => $f),
  440.          ($o->{hide_buttons} ? () : create_okcancel($o))),
  441.       );
  442.     $entry->grab_focus();
  443. }
  444.  
  445. sub _ask_from_list {
  446.     my ($o, $title, $messages, $l, $def) = @_;
  447.     my (undef, @okcancel) = ref $title ? @$title : $title;
  448.     my $list = new Gtk::CList(1);
  449.     my ($first_time, $starting_word, $start_reg) = (1, '', "^");
  450.     my (@widgets, $timeout, $curr);
  451.  
  452.     my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit };
  453.     my $select = sub {
  454.     $list->focus_row($_[0]);
  455.     $list->select_row($_[0], 0);
  456.     $list->moveto($_[0], 0, 0.5, 0);
  457.     };
  458.  
  459.     ref $title && !@okcancel ?
  460.       $list->signal_connect(button_release_event => $leave) :
  461.       $list->signal_connect(button_press_event => sub { &$leave if $_[1]{type} =~ /^2/ });
  462.  
  463.     $list->signal_connect(select_row => sub {
  464.     my ($w, $row, undef, $e) = @_;
  465.     $curr = $row;
  466.     });
  467.     $list->signal_connect(key_press_event => sub {
  468.         my ($w, $e) = @_;
  469.     my $c = chr $e->{keyval};
  470.  
  471.     Gtk->timeout_remove($timeout) if $timeout; $timeout = '';
  472.  
  473.     if ($e->{keyval} >= 0x100) {
  474.         &$leave if $c eq "\r" || $c eq "\x8d";
  475.         $starting_word = '' if $e->{keyval} != 0xffe4; # control
  476.     } else {
  477.         if ($e->{state} & 4) {
  478.         
  479.         $c eq "s" or return 1;
  480.         $start_reg and $start_reg = '', return 1;
  481.         $curr++;
  482.         } else {
  483.         &$leave if $c eq ' ';
  484.  
  485.         $curr++ if $starting_word eq '' || $starting_word eq $c;
  486.         $starting_word .= $c unless $starting_word eq $c;
  487.         }
  488.         my $word = quotemeta $starting_word;
  489.         my $j; for ($j = 0; $j < @$l; $j++) {
  490.          $l->[($j + $curr) % @$l] =~ /$start_reg$word/i and last;
  491.         }
  492.         $j == @$l ?
  493.           $starting_word = '' :
  494.           &$select(($j + $curr) % @$l);
  495.  
  496.         $w->{timeout} = $timeout = Gtk->timeout_add($forgetTime, sub { $timeout = $starting_word = ''; 0 } );
  497.     }
  498.     1;
  499.     });
  500.     $list->set_selection_mode('browse');
  501.     $list->set_column_auto_resize(0, 1);
  502.  
  503.     $o->{ok_clicked} = $leave;
  504.     $o->{cancel_clicked} = sub { $o->destroy; die "ask_from_list cancel" }; 
  505.     gtkadd($o->{window},
  506.        gtkpack($o->create_box_with_title(@$messages),
  507.            gtkpack_(new Gtk::VBox(0,7),
  508.                 1, @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, 280) : $list,
  509.                 @okcancel || !ref $title ? (0, create_okcancel($o, @okcancel)) : ())
  510.           ));
  511.     $o->show; 
  512.     my $toselect; map_index {
  513.     $list->append($_);
  514.     $toselect = $::i if $def && $_ eq $def;
  515.     } @$l;
  516.     &$select($toselect);
  517.  
  518.     $list->grab_focus;
  519. }
  520.  
  521. sub _ask_warn($@) {
  522.     my ($o, @msgs) = @_;
  523.     gtkadd($o->{window},
  524.       gtkpack($o->create_box_with_title(@msgs),
  525.          gtksignal_connect(my $w = new Gtk::Button(_("Ok")), "clicked" => sub { Gtk->main_quit }),
  526.          ),
  527.       );
  528.     $w->grab_focus();
  529. }
  530.  
  531. sub _ask_okcancel($@) {
  532.     my ($o, @msgs) = @_;
  533.     my ($ok, $cancel) = splice @msgs, -2;
  534.  
  535.     gtkadd($o->{window},
  536.        gtkpack(create_box_with_title($o, @msgs),
  537.            create_okcancel($o, $ok, $cancel),
  538.          )
  539.      );
  540.     $o->{ok}->grab_focus();
  541. }
  542.  
  543.  
  544. sub _ask_file($$) {
  545.     my ($o, $title) = @_;
  546.     my $f = $o->{rwindow} = new Gtk::FileSelection $title;
  547.     $f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename ; Gtk->main_quit });
  548.     $f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit });
  549.     $f->hide_fileop_buttons;
  550. }
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561.  
  562.  
  563.