summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorThierry Vignaud <thierry.vignaud@gmail.com>2013-08-30 15:18:47 +0200
committerThierry Vignaud <thierry.vignaud@gmail.com>2013-11-24 21:28:32 +0100
commit3252bfe856428c0a38ba7edb0f0ad6245537df6e (patch)
treee87c3026e82b3ca1d0bf9c3a191d0b7486cbf62c /perl-install
parente077d9de9c53e01dab6243941fc2ece05998f6ad (diff)
downloaddrakx-3252bfe856428c0a38ba7edb0f0ad6245537df6e.tar
drakx-3252bfe856428c0a38ba7edb0f0ad6245537df6e.tar.gz
drakx-3252bfe856428c0a38ba7edb0f0ad6245537df6e.tar.bz2
drakx-3252bfe856428c0a38ba7edb0f0ad6245537df6e.tar.xz
drakx-3252bfe856428c0a38ba7edb0f0ad6245537df6e.zip
forked
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/mygtk2.pm1598
-rw-r--r--perl-install/ugtk2.pm1652
2 files changed, 3250 insertions, 0 deletions
diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm
new file mode 100644
index 000000000..779e77e8f
--- /dev/null
+++ b/perl-install/mygtk2.pm
@@ -0,0 +1,1598 @@
+package mygtk2;
+
+use diagnostics;
+use strict;
+use feature 'state';
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(gtknew gtkset gtkadd gtkval_register gtkval_modify);
+
+use c;
+use log;
+use common;
+
+use Gtk2;
+
+sub init() {
+ !check_for_xserver() and print("Cannot be run in console mode.\n"), c::_exit(0);
+ $::one_message_has_been_translated and warn("N() was called from $::one_message_has_been_translated BEFORE gtk2 initialisation, replace it with a N_() AND a translate() later.\n"), c::_exit(1);
+
+ Gtk2->init;
+ Locale::gettext::bind_textdomain_codeset($_, 'UTF8') foreach 'libDrakX', if_(!$::isInstall, 'libDrakX-standalone'),
+ if_($::isRestore, 'draksnapshot'), if_($::isInstall, 'urpmi'),
+ 'drakx-net', 'drakx-kbd-mouse-x11', # shared translation
+ @::textdomains;
+ Glib->enable_exceptions2;
+}
+init() unless $::no_ugtk_init;
+Glib->enable_exceptions2 if $::isInstall;
+
+
+
+sub gtknew {
+ my $class = shift;
+ if (@_ % 2 != 0) {
+ internal_error("gtknew $class: bad options @_");
+ }
+ if (my $r = find { ref $_->[0] } group_by2(@_)) {
+ internal_error("gtknew $class: $r should be a string in @_");
+ }
+ my %opts = @_;
+ _gtk(undef, $class, 'gtknew', \%opts);
+}
+
+sub gtkset {
+ my $w = shift;
+ my $class = ref($w);
+ if (@_ % 2 != 0) {
+ internal_error("gtkset $class: bad options @_");
+ }
+ if (my $r = find { ref $_->[0] } group_by2(@_)) {
+ internal_error("gtkset $class: $r should be a string in @_");
+ }
+ my %opts = @_;
+
+ $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkset unknown class $class");
+
+ _gtk($w, $class, 'gtkset', \%opts);
+}
+
+sub gtkadd {
+ my $w = shift;
+ my $class = ref($w);
+ if (@_ % 2 != 0) {
+ internal_error("gtkadd $class: bad options @_");
+ }
+ if (my $r = find { ref $_->[0] } group_by2(@_)) {
+ internal_error("gtkadd $class: $r should be a string in @_");
+ }
+ my %opts = @_;
+ $class =~ s/^(Gtk2|Gtk2::Gdk|mygtk2)::// or internal_error("gtkadd unknown class $class");
+
+ _gtk($w, $class, 'gtkadd', \%opts);
+}
+
+
+my %refs;
+
+sub gtkval_register {
+ my ($w, $ref, $sub) = @_;
+ push @{$w->{_ref}}, $ref;
+ $w->signal_connect(destroy => sub {
+ @{$refs{$ref}} = grep { $_->[1] != $w } @{$refs{$ref}};
+ delete $refs{$ref} if !@{$refs{$ref}};
+ });
+ push @{$refs{$ref}}, [ $sub, $w ];
+}
+sub gtkval_modify {
+ my ($ref, $val, @to_skip) = @_;
+ my $prev = '' . $ref;
+ $$ref = $val;
+ if ($prev ne '' . $ref) {
+ internal_error();
+ }
+ foreach (@{$refs{$ref} || []}) {
+ my ($f, @para) = @$_;
+ $f->(@para) if !member($f, @to_skip);
+ }
+}
+
+my $global_tooltips;
+
+sub _gtk {
+ my ($w, $class, $action, $opts) = @_;
+
+ if (my $f = $mygtk2::{"_gtk__$class"}) {
+ $w = $f->($w, $opts, $class, $action);
+ } else {
+ internal_error("$action $class: unknown class");
+ }
+
+ $w->set_size_request(delete $opts->{width} || -1, delete $opts->{height} || -1) if exists $opts->{width} || exists $opts->{height};
+ if (my $position = delete $opts->{position}) {
+ $w->move($position->[0], $position->[1]);
+ }
+ $w->set_name(delete $opts->{widget_name}) if exists $opts->{widget_name};
+ $w->can_focus(delete $opts->{can_focus}) if exists $opts->{can_focus};
+ $w->can_default(delete $opts->{can_default}) if exists $opts->{can_default};
+ $w->grab_focus if delete $opts->{grab_focus};
+ $w->set_padding(@{delete $opts->{padding}}) if exists $opts->{padding};
+ $w->set_sensitive(delete $opts->{sensitive}) if exists $opts->{sensitive};
+ $w->signal_connect(expose_event => delete $opts->{expose_event}) if exists $opts->{expose_event};
+ $w->signal_connect(realize => delete $opts->{realize}) if exists $opts->{realize};
+ (delete $opts->{size_group})->add_widget($w) if $opts->{size_group};
+ if (my $tip = delete $opts->{tip}) {
+ $global_tooltips ||= Gtk2::Tooltips->new;
+ $global_tooltips->set_tip($w, $tip);
+ }
+
+ #- WARNING: hide_ref and show_ref are not effective until you gtkval_modify the ref
+ if (my $hide_ref = delete $opts->{hide_ref}) {
+ gtkval_register($w, $hide_ref, sub { $$hide_ref ? $w->hide : $w->show });
+ } elsif (my $show_ref = delete $opts->{show_ref}) {
+ gtkval_register($w, $show_ref, sub { $$show_ref ? $w->show : $w->hide });
+ }
+
+ if (my $sensitive_ref = delete $opts->{sensitive_ref}) {
+ my $set = sub { $w->set_sensitive($$sensitive_ref) };
+ gtkval_register($w, $sensitive_ref, $set);
+ $set->();
+ }
+
+ if (%$opts && !$opts->{allow_unknown_options}) {
+ internal_error("$action $class: unknown option(s) " . join(', ', keys %$opts));
+ }
+ $w;
+}
+
+sub _gtk__Install_Button {
+ my ($w, $opts, $_class) = @_;
+ $opts->{child} = gtknew('HBox', spacing => 5,
+ children_tight => [
+ # FIXME: not RTL compliant (lang::text_direction_rtl() ? ...)
+ gtknew('Image', file => 'advanced_expander'),
+ gtknew('Label', text => delete $opts->{text}),
+ ],
+ );
+ $opts->{relief} = 'none';
+ _gtk__Button($w, $opts, 'Button');
+}
+
+sub _gtk__Button { &_gtk_any_Button }
+sub _gtk__ToggleButton { &_gtk_any_Button }
+sub _gtk__CheckButton { &_gtk_any_Button }
+sub _gtk__RadioButton { &_gtk_any_Button }
+sub _gtk_any_Button {
+ my ($w, $opts, $class) = @_;
+
+ if (!$w) {
+ my @radio_options;
+ if ($class eq 'RadioButton') {
+ @radio_options = delete $opts->{group};
+ }
+ $w = $opts->{child} ? "Gtk2::$class"->new(@radio_options) :
+ delete $opts->{mnemonic} ? "Gtk2::$class"->new_with_mnemonic(@radio_options, delete $opts->{text} || '') :
+ $opts->{text} ? "Gtk2::$class"->new_with_label(@radio_options, delete $opts->{text} || '') :
+ "Gtk2::$class"->new(@radio_options);
+
+ $w->{format} = delete $opts->{format} if exists $opts->{format};
+ }
+
+ if (my $widget = delete $opts->{child}) {
+ $w->add($widget);
+ $widget->show;
+ }
+ $w->set_image(delete $opts->{image}) if exists $opts->{image};
+ $w->set_relief(delete $opts->{relief}) if exists $opts->{relief};
+
+ if (my $text_ref = delete $opts->{text_ref}) {
+ my $set = sub {
+ eval { $w->set_label(may_apply($w->{format}, $$text_ref)) };
+ };
+ gtkval_register($w, $text_ref, $set);
+ $set->();
+ } elsif (exists $opts->{text}) {
+ $w->set_label(delete $opts->{text});
+ } elsif (exists $opts->{stock}) {
+ $w->set_label(delete $opts->{stock});
+ $w->set_use_stock(1);
+ }
+
+ if ($class eq 'Button') {
+ $w->signal_connect(clicked => delete $opts->{clicked}) if exists $opts->{clicked};
+ } else {
+ if (my $active_ref = delete $opts->{active_ref}) {
+ my $set = sub { $w->set_active($$active_ref) };
+ $w->signal_connect(toggled => sub {
+ gtkval_modify($active_ref, $w->get_active, $set);
+ });
+ gtkval_register($w, $active_ref, $set);
+ gtkval_register($w, $active_ref, delete $opts->{toggled}) if exists $opts->{toggled};
+ $set->();
+ } else {
+ $w->set_active(delete $opts->{active}) if exists $opts->{active};
+ $w->signal_connect(toggled => delete $opts->{toggled}) if exists $opts->{toggled};
+ }
+ }
+ $w;
+}
+
+sub _gtk__CheckMenuItem {
+ my ($w, $opts, $class) = @_;
+
+ if (!$w) {
+ add2hash_($opts, { mnemonic => 1 });
+
+ $w = $opts->{image} || !exists $opts->{text} ? "Gtk2::$class"->new :
+ delete $opts->{mnemonic} ? "Gtk2::$class"->new_with_label(delete $opts->{text}) :
+ "Gtk2::$class"->new_with_mnemonic(delete $opts->{text});
+ }
+
+ $w->set_active(delete $opts->{active}) if exists $opts->{active};
+ $w->signal_connect(toggled => delete $opts->{toggled}) if exists $opts->{toggled};
+ $w;
+}
+
+sub _gtk__SpinButton {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $opts->{adjustment} ||= do {
+ add2hash_($opts, { step_increment => 1, page_increment => 5, page_size => 1, value => delete $opts->{lower} });
+ Gtk2::Adjustment->new(delete $opts->{value}, delete $opts->{lower}, delete $opts->{upper}, delete $opts->{step_increment}, delete $opts->{page_increment}, delete $opts->{page_size});
+ };
+ $w = Gtk2::SpinButton->new(delete $opts->{adjustment}, delete $opts->{climb_rate} || 0, delete $opts->{digits} || 0);
+ }
+
+ $w->signal_connect(value_changed => delete $opts->{value_changed}) if exists $opts->{value_changed};
+ $w;
+}
+
+sub _gtk__HScale {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $opts->{adjustment} ||= do {
+ add2hash_($opts, { step_increment => 1, page_increment => 5, page_size => 1 });
+ add2hash_($opts, { value => $opts->{lower} }) if !exists $opts->{value};
+ Gtk2::Adjustment->new(delete $opts->{value}, delete $opts->{lower}, (delete $opts->{upper}) + 1, delete $opts->{step_increment}, delete $opts->{page_increment}, delete $opts->{page_size});
+ };
+ $w = Gtk2::HScale->new(delete $opts->{adjustment});
+ }
+
+ $w->set_digits(delete $opts->{digits}) if exists $opts->{digits};
+ if (my $value_ref = delete $opts->{value_ref}) {
+ my $set = sub { $w->set_value($$value_ref) };
+ gtkval_register($w, $value_ref, $set);
+ $set->();
+ $w->signal_connect(value_changed => sub {
+ gtkval_modify($value_ref, $w->get_value, $set);
+ });
+ }
+ $w->signal_connect(value_changed => delete $opts->{value_changed}) if exists $opts->{value_changed};
+ $w;
+}
+
+sub _gtk__ProgressBar {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::ProgressBar->new;
+ }
+
+ if (my $fraction_ref = delete $opts->{fraction_ref}) {
+ my $set = sub { $w->set_fraction($$fraction_ref) };
+ gtkval_register($w, $fraction_ref, $set);
+ $set->();
+ } elsif (exists $opts->{fraction}) {
+ $w->set_fraction(delete $opts->{fraction});
+ }
+
+ $w;
+}
+
+sub _gtk__VSeparator { &_gtk_any_simple }
+sub _gtk__HSeparator { &_gtk_any_simple }
+sub _gtk__Calendar { &_gtk_any_simple }
+
+sub _gtk__DrawingArea {
+ my ($w, $_opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::DrawingArea->new;
+ }
+ $w;
+}
+
+sub _gtk__Pixbuf {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ my $name = delete $opts->{file} or internal_error("missing file");
+ my $file = _find_imgfile($name) or internal_error("cannot find image $name");
+ if (my $size = delete $opts->{size}) {
+ $w = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($file, $size, $size, 1);
+ } else {
+ $w = Gtk2::Gdk::Pixbuf->new_from_file($file);
+ }
+ $w = $w->flip(1) if delete $opts->{flip};
+ }
+ $w;
+}
+
+# Image_using_pixmap is rendered using DITHER_MAX which is much better on 16bpp displays
+sub _gtk__Image_using_pixmap { &_gtk__Image }
+# Image_using_pixbuf is rendered using DITHER_MAX & transparency which is much better on 16bpp displays
+sub _gtk__Image_using_pixbuf { &_gtk__Image }
+sub _gtk__Image {
+ my ($w, $opts, $class) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Image->new;
+ $w->{format} = delete $opts->{format} if exists $opts->{format};
+
+ $w->set_from_stock(delete $opts->{stock}, 'button') if exists $opts->{stock};
+
+ $w->{options} = { flip => delete $opts->{flip} };
+
+ $w->{set_from_file} = $class =~ /using_pixmap/ ? sub {
+ my ($w, $file) = @_;
+ my $pixmap = mygtk2::pixmap_from_pixbuf($w, gtknew('Pixbuf', file => $file));
+ $w->set_from_pixmap($pixmap, undef);
+ } : $class =~ /using_pixbuf/ ? sub {
+ my ($w, $file) = @_;
+ my $pixbuf = _pixbuf_render_alpha(gtknew('Pixbuf', file => $file, %{$w->{options}}), 255);
+ my ($width, $height) = ($pixbuf->get_width, $pixbuf->get_height);
+ $w->set_size_request($width, $height);
+ $w->{pixbuf} = $pixbuf;
+ $w->signal_connect(expose_event => sub {
+ my (undef, $event) = @_;
+ if (!$w->{x}) {
+ my $alloc = $w->allocation;
+ $w->{x} = $alloc->x;
+ $w->{y} = $alloc->y;
+ }
+ # workaround Gtk+ bug: in installer, first event is not complete and rectables are bogus:
+ if ($::isInstall) {
+ $pixbuf->render_to_drawable($w->window, $w->style->fg_gc('normal'),
+ 0, 0, $w->{x}, $w->{y}, $width, $height, 'max', 0, 0);
+ return;
+ }
+ foreach my $rect ($event->region->get_rectangles) {
+ my @values = $rect->values;
+ $pixbuf->render_to_drawable($w->window, $w->style->fg_gc('normal'),
+ @values[0..1], $w->{x}+$values[0], $w->{y}+$values[1], @values[2..3], 'max', 0, 0);
+ }
+ });
+ } : sub {
+ my ($w, $file, $o_size) = @_;
+ my $pixbuf = gtknew('Pixbuf', file => $file, if_($o_size, size => $o_size), %{$w->{options}});
+ $w->set_from_pixbuf($pixbuf);
+ };
+ }
+
+ if (my $name = delete $opts->{file}) {
+ my $file = _find_imgfile(may_apply($w->{format}, $name)) or internal_error("cannot find image $name");
+ $w->{set_from_file}->($w, $file, delete $opts->{size});
+ } elsif (my $file_ref = delete $opts->{file_ref}) {
+ my $set = sub {
+ my $file = _find_imgfile(may_apply($w->{format}, $$file_ref)) or internal_error("cannot find image $$file_ref");
+ $w->{set_from_file}->($w, $file, delete $opts->{size});
+ };
+ gtkval_register($w, $file_ref, $set);
+ $set->() if $$file_ref;
+ }
+ $w;
+}
+
+sub _gtk__WrappedLabel {
+ my ($w, $opts) = @_;
+
+ $opts->{line_wrap} = 1 if !defined $opts->{line_wrap};
+ _gtk__Label($w, $opts);
+}
+
+our $left_padding = 20;
+
+sub _gtk__Label_Left {
+ my ($w, $opts) = @_;
+ $opts->{alignment} ||= [ 0, 0 ];
+ $opts->{padding} ||= [ $left_padding, 0 ];
+ _gtk__WrappedLabel($w, $opts);
+}
+
+sub _gtk__Label_Right {
+ my ($w, $opts) = @_;
+ $opts->{alignment} ||= [ 1, 0.5 ];
+ _gtk__Label($w, $opts);
+}
+
+
+sub _gtk__Label {
+ my ($w, $opts) = @_;
+
+ if ($w) {
+ $w->set_text(delete $opts->{text}) if exists $opts->{text};
+ } else {
+ $w = exists $opts->{text} ? Gtk2::Label->new(delete $opts->{text}) : Gtk2::Label->new;
+ $w->set_selectable(delete $opts->{selectable}) if exists $opts->{selectable};
+ $w->set_ellipsize(delete $opts->{ellipsize}) if exists $opts->{ellipsize};
+ $w->set_justify(delete $opts->{justify}) if exists $opts->{justify};
+ $w->set_line_wrap(delete $opts->{line_wrap}) if exists $opts->{line_wrap};
+ $w->set_alignment(@{delete $opts->{alignment}}) if exists $opts->{alignment};
+ $w->modify_font(Gtk2::Pango::FontDescription->from_string(delete $opts->{font})) if exists $opts->{font};
+ }
+
+ if (my $text_ref = delete $opts->{text_ref}) {
+ my $set = sub { $w->set_text($$text_ref) };
+ gtkval_register($w, $text_ref, $set);
+ $set->();
+ }
+
+ if (my $t = delete $opts->{text_markup}) {
+ $w->set_markup($t);
+ if ($w->get_text eq '') {
+ log::l("invalid markup in $t. not using the markup");
+ $w->set_text($t);
+ }
+ }
+ $w;
+}
+
+
+sub _gtk__Alignment {
+ my ($w, $_opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Alignment->new(0, 0, 0, 0);
+ }
+ $w;
+}
+
+
+sub title1_to_markup {
+ my ($label) = @_;
+ if ($::isInstall) {
+ my $font = lang::l2pango_font($::o->{locale}{lang});
+ if (my ($font_size) = $font =~ /(\d+)/) {
+ $font_size++;
+ $font =~ s/\d+/$font_size/;
+ }
+ qq(<span foreground="#5A8AD6" font="$font">$label</span>);
+ } else {
+ qq(<b><big>$label</big></b>);
+ }
+}
+
+sub _gtk__Install_Title {
+ my ($w, $opts) = @_;
+ local $opts->{widget_name} = 'Banner';
+ $opts->{text} = uc($opts->{text}) if $::isInstall;
+ gtknew('HBox', widget_name => 'Banner', children => [
+ 0, gtknew('Label', padding => [ 6, 0 ]),
+ 1, gtknew('VBox', widget_name => 'Banner', children_tight => [
+ _gtk__Title2($w, $opts),
+ if_($::isInstall, Gtk2::HSeparator->new),
+ ]),
+ 0, gtknew('Label', padding => [ 6, 0 ]),
+ ]);
+}
+
+sub _gtk__Title1 {
+ my ($w, $opts) = @_;
+ $opts ||= {};
+ $opts->{text_markup} = title1_to_markup(delete($opts->{label})) if $opts->{label};
+ _gtk__WrappedLabel($w, $opts);
+}
+
+sub _gtk__Title2 {
+ my ($w, $opts) = @_;
+ $opts ||= {};
+ $opts->{alignment} = [ 0, 0 ];
+ _gtk__Title1($w, $opts);
+}
+
+sub _gtk__Sexy_IconEntry {
+ my ($w, $opts) = @_;
+
+ require Gtk2::Sexy;
+ if (!$w) {
+ $w = Gtk2::Sexy::IconEntry->new;
+ $w->set_editable(delete $opts->{editable}) if exists $opts->{editable};
+ }
+
+ $w->add_clear_button if delete $opts->{clear_button};
+ if (my $icon = delete $opts->{primary_icon}) {
+ $w->set_icon('primary', $icon);
+ $w->set_icon_highlight('primary', $icon);
+ }
+ if (my $icon = delete $opts->{secondary_icon}) {
+ $w->set_icon('secondary', $icon);
+ $w->set_icon_highlight('secondary', $icon);
+ }
+
+ $w->signal_connect('icon-released' => delete $opts->{'icon-released'}) if exists $opts->{'icon-released'};
+ $w->signal_connect('icon-pressed' => delete $opts->{'icon-pressed'}) if exists $opts->{'icon-pressed'};
+
+ _gtk__Entry($w, $opts);
+}
+
+sub _gtk__Entry {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Entry->new;
+ $w->set_editable(delete $opts->{editable}) if exists $opts->{editable};
+ }
+
+ if (my $icon = delete $opts->{primary_icon}) {
+ $w->set_icon_from_stock('primary', $icon);
+ #$w->set_icon_highlight('primary', $icon);
+ }
+ if (my $icon = delete $opts->{secondary_icon}) {
+ $w->set_icon_from_stock('secondary', $icon);
+ #$w->set_icon_highlight('secondary', $icon);
+ }
+
+ $w->signal_connect('icon-release' => delete $opts->{'icon-release'}) if exists $opts->{'icon-release'};
+ $w->signal_connect('icon-press' => delete $opts->{'icon-press'}) if exists $opts->{'icon-press'};
+
+ $w->set_text(delete $opts->{text}) if exists $opts->{text};
+ $w->signal_connect(key_press_event => delete $opts->{key_press_event}) if exists $opts->{key_press_event};
+
+ if (my $text_ref = delete $opts->{text_ref}) {
+ my $set = sub { $w->set_text($$text_ref) };
+ gtkval_register($w, $text_ref, $set);
+ $set->();
+ $w->signal_connect(changed => sub {
+ gtkval_modify($text_ref, $w->get_text, $set);
+ });
+ }
+
+ $w;
+}
+
+sub _gtk__WeaknessCheckEntry {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = _gtk__Entry($w, $opts);
+ }
+
+ $w->signal_connect('changed' => sub {
+ require authentication;
+ my $password_weakness = authentication::compute_password_weakness($w->get_text);
+ $w->set_icon_from_pixbuf('GTK_ENTRY_ICON_SECONDARY', _get_weakness_icon($password_weakness));
+ $w->set_icon_tooltip_text('GTK_ENTRY_ICON_SECONDARY', _get_weakness_tooltip($password_weakness));
+ });
+
+ $w;
+}
+
+sub _gtk__TextView {
+ my ($w, $opts, $_class, $action) = @_;
+
+ if (!$w) {
+ $w = Gtk2::TextView->new;
+ $w->set_editable(delete $opts->{editable}) if exists $opts->{editable};
+ $w->set_wrap_mode(delete $opts->{wrap_mode}) if exists $opts->{wrap_mode};
+ $w->set_cursor_visible(delete $opts->{cursor_visible}) if exists $opts->{cursor_visible};
+ }
+
+ _text_insert($w, delete $opts->{text}, append => $action eq 'gtkadd') if exists $opts->{text};
+ $w;
+}
+
+sub _gtk__WebKit_View {
+ my ($w, $opts, $_class, $_action) = @_;
+ if (!$w) {
+ $w = Gtk2::WebKit::WebView->new;
+ }
+
+ # disable contextual menu:
+ if (delete $opts->{no_popup_menu}) {
+ $w->signal_connect('populate-popup' => sub {
+ my (undef, $menu) = @_;
+ $menu->destroy if $menu;
+ 1;
+ });
+ }
+
+ $w;
+}
+
+sub _gtk__ComboBox {
+ my ($w, $opts, $_class, $action) = @_;
+
+ if (!$w) {
+ $w = Gtk2::ComboBox->new_text;
+ $w->{format} = delete $opts->{format} if exists $opts->{format};
+
+ }
+ my $set_list = sub {
+ $w->{formatted_list} = $w->{format} ? [ map { $w->{format}($_) } @{$w->{list}} ] : $w->{list};
+ $w->get_model->clear;
+ $w->{strings} = $w->{formatted_list}; # used by Gtk2::ComboBox wrappers such as get_text() in ugtk2
+ $w->append_text($_) foreach @{$w->{formatted_list}};
+ };
+ if (my $list_ref = delete $opts->{list_ref}) {
+ !$opts->{list} or internal_error("both list and list_ref");
+ my $set = sub {
+ $w->{list} = $$list_ref;
+ $set_list->();
+ };
+ gtkval_register($w, $list_ref, $set);
+ $set->();
+ } elsif (exists $opts->{list}) {
+ $w->{list} = delete $opts->{list};
+ $set_list->();
+ }
+
+ if ($action eq 'gtknew') {
+ if (my $text_ref = delete $opts->{text_ref}) {
+ my $set = sub {
+ my $val = may_apply($w->{format}, $$text_ref);
+ eval { $w->set_active(find_index { $_ eq $val } @{$w->{formatted_list}}) };
+ };
+ $w->signal_connect(changed => sub {
+ gtkval_modify($text_ref, $w->{list}[$w->get_active], $set);
+ });
+ gtkval_register($w, $text_ref, $set);
+ gtkval_register($w, $text_ref, delete $opts->{changed}) if exists $opts->{changed};
+ $set->();
+ } else {
+ my $val = delete $opts->{text};
+ eval { $w->set_active(find_index { $_ eq $val } @{$w->{formatted_list}}) } if defined $val;
+ $w->signal_connect(changed => delete $opts->{changed}) if exists $opts->{changed};
+ }
+ }
+ $w;
+}
+
+sub _gtk__ScrolledWindow {
+ my ($w, $opts, $_class, $action) = @_;
+
+ if (!$w) {
+ $w = Gtk2::ScrolledWindow->new(undef, undef);
+ $w->set_policy(delete $opts->{h_policy} || 'automatic', delete $opts->{v_policy} || 'automatic');
+ }
+
+ my $faked_w = $w;
+
+ if (my $child = delete $opts->{child}) {
+ if (member(ref($child), qw(Gtk2::Layout Gtk2::Html2::View Gtk2::SimpleList Gtk2::SourceView::View Gtk2::Text Gtk2::TextView Gtk2::TreeView Gtk2::WebKit::WebView))) {
+ $w->add($child);
+ } else {
+ $w->add_with_viewport($child);
+ }
+ $child->set_focus_vadjustment($w->get_vadjustment) if $child->can('set_focus_vadjustment');
+ $child->set_left_margin(6) if ref($child) =~ /Gtk2::TextView/ && $child->get_left_margin <= 6;
+ $child->show;
+
+ $w->child->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};
+
+ if (ref($child) eq 'Gtk2::TextView' && delete $opts->{to_bottom}) {
+ $child->{to_bottom} = _allow_scroll_TextView_to_bottom($w, $child);
+ }
+
+ if (!delete $opts->{no_shadow} && $action eq 'gtknew' && ref($child) =~ /Gtk2::(Html2|SimpleList|TextView|TreeView|WebKit::WebView)/) {
+ $faked_w = gtknew('Frame', shadow_type => 'in', child => $w);
+ }
+ }
+ $faked_w;
+}
+
+sub _gtk__Frame {
+ my ($w, $opts) = @_;
+
+ if ($w) {
+ $w->set_label(delete $opts->{text}) if exists $opts->{text};
+ } else {
+ $w = Gtk2::Frame->new(delete $opts->{text});
+ $w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
+ $w->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};
+ }
+
+ if (my $child = delete $opts->{child}) {
+ $w->add($child);
+ $child->show;
+ }
+ $w;
+}
+
+sub _gtk__Expander {
+ my ($w, $opts) = @_;
+
+ if ($w) {
+ $w->set_label(delete $opts->{text}) if exists $opts->{text};
+ } else {
+ $w = Gtk2::Expander->new(delete $opts->{text});
+ }
+
+ $w->signal_connect(activate => delete $opts->{activate}) if exists $opts->{activate};
+
+ if (my $child = delete $opts->{child}) {
+ $w->add($child);
+ $child->show;
+ }
+ $w;
+}
+
+
+
+sub _gtk__MDV_Notebook {
+ my ($w, $opts, $_class, $_action) = @_;
+ if (!$w) {
+ import_style_ressources();
+
+ my ($layout, $selection_arrow, $selection_bar);
+ my $parent_window = delete $opts->{parent_window} || root_window();
+ my $root_height = first($parent_window->get_size);
+ my $suffix = $root_height == 800 && !$::isStandalone ? '_600' : '_768';
+ # the white square is a little bit above the actual left sidepanel:
+ my $offset = 20;
+ my $is_flip_needed = text_direction_rtl();
+ my $filler = gtknew('Image', file => 'left-background-filler.png');
+ my $filler_height = $filler->get_pixbuf->get_height;
+ my $left_background = gtknew('Image_using_pixbuf', file => 'left-background.png');
+ my $lf_height = $left_background->{pixbuf}->get_height;
+ my @right_background = $::isInstall ?
+ gtknew('Image', file => "right-white-background_left_part$suffix", flip => $is_flip_needed)
+ : map {
+ gtknew('Image', file => "right-white-background_left_part-$_", flip => $is_flip_needed);
+ } 1, 2, 2, 3;
+ my $width1 = $left_background->{pixbuf}->get_width;
+ my $total_width = $width1 + $right_background[0]->get_pixbuf->get_width;
+ my $arrow_x = text_direction_rtl() ? $offset/2 - 4 : $width1 - $offset - 3;
+ $w = gtknew('HBox', spacing => 0, children => [
+ 0, $layout = gtknew('Layout', width => $total_width - $offset, children => [ #Layout Fixed
+ # stacking order is important for "Z-buffer":
+ [ $left_background, 0, 0 ],
+ if_($suffix ne '_600',
+ [ $filler, 0, $lf_height ],
+ [ gtknew('Image', file => 'left-background-filler.png'), 0, $lf_height + $filler_height ],
+ [ gtknew('Image', file => 'left-background-filler.png'), 0, $lf_height + $filler_height*2 ],
+ ),
+ [ $selection_bar = gtknew('Image', file => 'rollover.png'), 0, 0 ], # arbitrary vertical position
+ ($opts->{children} ? @{ delete $opts->{children} } : ()),
+ [ my $box = gtknew('VBox', spacing => 0, height => -1, children => [
+ 0, $right_background[0],
+ if_(!$::isInstall,
+ 1, $right_background[1],
+ 1, $right_background[2], # enought up to to XYZx1280 resolution
+ 0, $right_background[3],
+ ),
+ ]), (text_direction_rtl() ? 0 : $width1 - $offset), 0 ],
+ # stack on top (vertical position is arbitrary):
+ [ $selection_arrow = gtknew('Image', file => 'steps_on', flip => $is_flip_needed), $arrow_x, 0, ],
+ ]),
+ 1, delete $opts->{right_child} ||
+ gtknew('Image_using_pixbuf', file => "right-white-background_right_part$suffix", flip => $is_flip_needed),
+ ]);
+
+ $w->signal_connect('size-allocate' => sub {
+ my (undef, $requisition) = @_;
+ state $width ||= $right_background[0]->get_pixbuf->get_width;
+ $box->set_size_request($width, $requisition->height);
+ });
+ $_->set_property('no-show-all', 1) foreach $selection_bar, $selection_arrow;
+ bless($w, 'Gtk2::MDV_Notebook');
+ add2hash($w, {
+ arrow_x => $arrow_x,
+ layout => $layout,
+ selection_arrow => $selection_arrow,
+ selection_bar =>$selection_bar,
+ });
+ }
+ $w;
+}
+
+
+sub _gtk__Fixed {
+ my ($w, $opts, $_class, $_action) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Fixed->new;
+ $w->set_has_window(delete $opts->{has_window}) if exists $opts->{has_window};
+ _gtknew_handle_layout_children($w, $opts);
+ }
+ $w;
+}
+
+sub _gtk__Layout {
+ my ($w, $opts, $_class, $_action) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Layout->new;
+ _gtknew_handle_layout_children($w, $opts);
+ }
+ $w;
+}
+
+sub _gtknew_handle_layout_children {
+ my ($w, $opts) = @_;
+ $opts->{children} ||= [];
+ push @{$opts->{children}}, [ delete $opts->{child}, delete $opts->{x}, delete $opts->{y} ] if exists $opts->{child};
+ foreach (@{$opts->{children}}) {
+ $w->put(@$_);
+ }
+ delete $opts->{children};
+
+ if ($opts->{pixbuf_file}) {
+ my $pixbuf = if_($opts->{pixbuf_file}, gtknew('Pixbuf', file => delete $opts->{pixbuf_file}));
+ $w->signal_connect(
+ realize => sub {
+ ugtk2::set_back_pixbuf($w, $pixbuf);
+ });
+ }
+}
+
+
+sub _gtk__Window { &_gtk_any_Window }
+sub _gtk__Dialog { &_gtk_any_Window }
+sub _gtk__Plug { &_gtk_any_Window }
+sub _gtk_any_Window {
+ my ($w, $opts, $class) = @_;
+
+ if (!$w) {
+ if ($class eq 'Window') {
+ $w = "Gtk2::$class"->new(delete $opts->{type} || 'toplevel');
+ } elsif ($class eq 'Plug') {
+ $opts->{socket_id} or internal_error("cannot create a Plug without a socket_id");
+ $w = "Gtk2::$class"->new(delete $opts->{socket_id});
+ } elsif ($class eq 'FileChooserDialog') {
+ my $action = delete $opts->{action} || internal_error("missing action for FileChooser");
+ $w = Gtk2::FileChooserDialog->new(delete $opts->{title}, delete $opts->{transient_for} || $::main_window,
+ $action, N("Cancel") => 'cancel', delete $opts->{button1} || N("Ok") => 'ok',
+ );
+ } else {
+ $w = "Gtk2::$class"->new;
+ }
+
+ if ($::isInstall || $::set_dialog_hint) {
+ $w->set_type_hint('dialog'); # for matchbox window manager
+ }
+
+ $w->set_modal(delete $opts->{modal}) if exists $opts->{modal};
+ $opts->{transient_for} ||= $::main_window if $::main_window;
+ $w->set_modal(1) if exists $opts->{transient_for};
+ $w->set_transient_for(delete $opts->{transient_for}) if exists $opts->{transient_for};
+ $w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
+ $w->set_shadow_type(delete $opts->{shadow_type}) if exists $opts->{shadow_type};
+ $w->set_position(delete $opts->{position_policy}) if exists $opts->{position_policy};
+ $w->set_default_size(delete $opts->{default_width} || -1, delete $opts->{default_height} || -1) if exists $opts->{default_width} || exists $opts->{default_height};
+ my $icon_no_error = $opts->{icon_no_error};
+ if (my $name = delete $opts->{icon} || delete $opts->{icon_no_error}) {
+ if (my $f = _find_imgfile($name)) {
+ $w->set_icon(gtknew('Pixbuf', file => $f));
+ } elsif (!$icon_no_error) {
+ internal_error("cannot find $name");
+ }
+ }
+ }
+ $w->set_title(delete $opts->{title}) if exists $opts->{title};
+
+ if (my $child = delete $opts->{child}) {
+ $w->add($child);
+ $child->show;
+ }
+ $w;
+}
+
+my $previous_popped_and_reuse_window;
+
+sub destroy_previous_popped_and_reuse_window() {
+ $previous_popped_and_reuse_window or return;
+
+ $previous_popped_and_reuse_window->destroy;
+ $previous_popped_and_reuse_window = undef;
+}
+
+sub _gtk__MagicWindow {
+ my ($w, $opts) = @_;
+
+ my $pop_it = delete $opts->{pop_it} || !$::isWizard && !$::isEmbedded || $::WizardTable && do {
+ #- do not take into account the wizard banner
+ # FIXME!!!
+ any { !$_->isa('Gtk2::DrawingArea') && $_->visible } $::WizardTable->get_children;
+ };
+
+ my $pop_and_reuse = delete $opts->{pop_and_reuse} && $pop_it;
+ my $sub_child = delete $opts->{child};
+ my $provided_banner = delete $opts->{banner};
+
+ if ($pop_it && $provided_banner) {
+ $sub_child = gtknew('VBox', children => [ 0, $provided_banner, if_($sub_child, 1, $sub_child) ]);
+ } else {
+ $sub_child ||= gtknew('VBox');
+ }
+ if (!$pop_and_reuse) {
+ destroy_previous_popped_and_reuse_window();
+ }
+
+ if ($previous_popped_and_reuse_window && $pop_and_reuse) {
+ $w = $previous_popped_and_reuse_window;
+ $w->remove($w->child);
+
+ gtkadd($w, child => $sub_child);
+ %$opts = ();
+ } elsif ($pop_it) {
+ $opts->{child} = $sub_child;
+
+ $w = _create_Window($opts, '');
+ $previous_popped_and_reuse_window = $w if $pop_and_reuse;
+ } else {
+ if (!$::WizardWindow) {
+
+ my $banner;
+ if (!$::isEmbedded && !$::isInstall && $::Wizard_title) {
+ if (_find_imgfile($opts->{icon_no_error})) {
+ $banner = Gtk2::Banner->new($opts->{icon_no_error}, $::Wizard_title);
+ } else {
+ log::l("ERROR: missing wizard banner $opts->{icon_no_error}");
+ }
+ }
+ $::WizardTable = gtknew('VBox', if_($banner, children_tight => [ $banner ]));
+
+ if ($::isEmbedded) {
+ add2hash($opts, {
+ socket_id => $::XID,
+ child => $::WizardTable,
+ });
+ delete $opts->{no_Window_Manager};
+ $::Plug = $::WizardWindow = _gtk(undef, 'Plug', 'gtknew', $opts);
+ sync($::WizardWindow);
+ } else {
+ add2hash($opts, {
+ child => $::WizardTable,
+ });
+ $::WizardWindow = _create_Window($opts, 'special_center');
+ }
+ } else {
+ %$opts = ();
+ }
+
+ set_main_window_size($::WizardWindow);
+
+ $w = $::WizardWindow;
+
+ gtkadd($::WizardTable, children_tight => [ $provided_banner ]) if $provided_banner;
+ gtkadd($::WizardTable, children_loose => [ $sub_child ]);
+ }
+ bless {
+ real_window => $w,
+ child => $sub_child, pop_it => $pop_it, pop_and_reuse => $pop_and_reuse,
+ if_($provided_banner, banner => $provided_banner),
+ }, 'mygtk2::MagicWindow';
+}
+
+# A standard About dialog. Used with:
+# my $w = gtknew('AboutDialog', ...);
+# $w->show_all;
+# $w->run;
+sub _gtk__AboutDialog {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::AboutDialog->new;
+ $w->signal_connect(response => sub { $_[0]->destroy });
+ $w->set_program_name(delete $opts->{name}) if exists $opts->{name};
+ $w->set_version(delete $opts->{version}) if exists $opts->{version};
+ $w->set_icon(gtknew('Pixbuf', file => delete $opts->{icon})) if exists $opts->{icon};
+ $w->set_logo(gtknew('Pixbuf', file => delete $opts->{logo})) if exists $opts->{logo};
+ $w->set_copyright(delete $opts->{copyright}) if exists $opts->{copyright};
+ $w->set_url_hook(sub {
+ my (undef, $url) = @_;
+ run_program::raw({ detach => 1 }, 'www-browser', $url);
+ });
+ $w->set_email_hook(sub {
+ my (undef, $url) = @_;
+ run_program::raw({ detach => 1 }, 'www-browser', $url);
+ });
+
+ if (my $url = delete $opts->{website}) {
+ $url =~ s/^https:/http:/; # Gtk2::About doesn't like "https://..." like URLs
+ $w->set_website($url);
+ }
+ $w->set_license(delete $opts->{license}) if exists $opts->{license};
+ $w->set_wrap_license(delete $opts->{wrap_license}) if exists $opts->{wrap_license};
+ $w->set_comments(delete $opts->{comments}) if exists $opts->{comments};
+ $w->set_website_label(delete $opts->{website_label}) if exists $opts->{website_label};
+ $w->set_authors(delete $opts->{authors}) if exists $opts->{authors};
+ $w->set_documenters(delete $opts->{documenters}) if exists $opts->{documenters};
+ $w->set_translator_credits(delete $opts->{translator_credits}) if exists $opts->{translator_credits};
+ $w->set_artists(delete $opts->{artists}) if exists $opts->{artists};
+ $w->set_modal(delete $opts->{modal}) if exists $opts->{modal};
+ $w->set_transient_for(delete $opts->{transient_for}) if exists $opts->{transient_for};
+ $w->set_position(delete $opts->{position_policy}) if exists $opts->{position_policy};
+ }
+ $w;
+}
+
+sub _gtk__FileSelection {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::FileSelection->new(delete $opts->{title} || '');
+ gtkset($w->ok_button, %{delete $opts->{ok_button}}) if exists $opts->{ok_button};
+ gtkset($w->cancel_button, %{delete $opts->{cancel_button}}) if exists $opts->{cancel_button};
+ }
+ $w;
+}
+
+sub _gtk__FileChooserDialog { &_gtk_any_Window }
+
+sub _gtk__FileChooser {
+ my ($w, $opts) = @_;
+
+ #- no nice way to have a {file_ref} on a FileChooser since selection_changed only works for browsing, not file/folder creation
+
+ if (!$w) {
+ my $action = delete $opts->{action} || internal_error("missing action for FileChooser");
+ $w = Gtk2::FileChooserWidget->new($action);
+
+ my $file = $opts->{file} && delete $opts->{file};
+
+ if (my $dir = delete $opts->{directory} || $file && dirname($file)) {
+ $w->set_current_folder($dir);
+ }
+ if ($file) {
+ if ($action =~ /save|create/) {
+ $w->set_current_name(basename($file));
+ } else {
+ $w->set_filename($file);
+ }
+ }
+ }
+ $w;
+}
+
+sub _gtk__VPaned { &_gtk_any_Paned }
+sub _gtk__HPaned { &_gtk_any_Paned }
+sub _gtk_any_Paned {
+ my ($w, $opts, $class, $action) = @_;
+
+ if (!$w) {
+ $w = "Gtk2::$class"->new;
+ $w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
+ $w->set_position(delete $opts->{position}) if exists $opts->{position};
+ } elsif ($action eq 'gtkset') {
+ $_->destroy foreach $w->get_children;
+ }
+
+ foreach my $opt (qw(resize1 shrink1 resize2 shrink2)) {
+ $opts->{$opt} = 1 if !defined $opts->{$opt};
+ }
+ $w->pack1(delete $opts->{child1}, delete $opts->{resize1}, delete $opts->{shrink1});
+ $w->pack2(delete $opts->{child2}, delete $opts->{resize2}, delete $opts->{shrink2});
+ $w;
+}
+
+sub _gtk__VBox { &_gtk_any_Box }
+sub _gtk__HBox { &_gtk_any_Box }
+sub _gtk_any_Box {
+ my ($w, $opts, $class, $action) = @_;
+
+ if (!$w) {
+ $w = "Gtk2::$class"->new;
+ $w->set_homogeneous(delete $opts->{homogenous}) if exists $opts->{homogenous};
+ $w->set_spacing(delete $opts->{spacing}) if exists $opts->{spacing};
+ $w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
+ } elsif ($action eq 'gtkset') {
+ $_->destroy foreach $w->get_children;
+ }
+
+ _gtknew_handle_children($w, $opts);
+ $w;
+}
+
+sub _gtk__VButtonBox { &_gtk_any_ButtonBox }
+sub _gtk__HButtonBox { &_gtk_any_ButtonBox }
+sub _gtk_any_ButtonBox {
+ my ($w, $opts, $class, $action) = @_;
+
+ if (!$w) {
+ $w = "Gtk2::$class"->new;
+ $w->set_homogeneous(delete $opts->{homogenous}) if exists $opts->{homogenous};
+ $w->set_border_width(delete $opts->{border_width}) if exists $opts->{border_width};
+ $w->set_spacing(delete $opts->{spacing}) if exists $opts->{spacing};
+ $w->set_layout(delete $opts->{layout} || 'spread');
+ } elsif ($action eq 'gtkset') {
+ $_->destroy foreach $w->get_children;
+ }
+
+ _gtknew_handle_children($w, $opts);
+ $w;
+}
+
+sub _gtk__Notebook {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ $w = Gtk2::Notebook->new;
+ $w->set_property('show-tabs', delete $opts->{show_tabs}) if exists $opts->{show_tabs};
+ $w->set_property('show-border', delete $opts->{show_border}) if exists $opts->{show_border};
+ }
+
+ if (exists $opts->{children}) {
+ foreach (group_by2(@{delete $opts->{children}})) {
+ my ($title, $page) = @$_;
+ $w->append_page($page, $title);
+ $page->show;
+ $title->show;
+ }
+ }
+ $w;
+}
+
+sub _gtk__Table {
+ my ($w, $opts) = @_;
+
+ if (!$w) {
+ add2hash_($opts, { xpadding => 5, ypadding => 0, border_width => $::isInstall ? 3 : 10 });
+
+ $w = Gtk2::Table->new(0, 0, delete $opts->{homogeneous} || 0);
+ $w->set_col_spacings(delete $opts->{col_spacings} || 0);
+ $w->set_row_spacings(delete $opts->{row_spacings} || 0);
+ $w->set_border_width(delete $opts->{border_width});
+ $w->{$_} = delete $opts->{$_} foreach 'xpadding', 'ypadding', 'mcc';
+ }
+
+ each_index {
+ my ($i, $l) = ($::i, $_);
+ each_index {
+ my $j = $::i;
+ if ($_) {
+ ref $_ or $_ = Gtk2::WrappedLabel->new($_);
+ $w->attach($_, $j, $j + 1, $i, $i + 1,
+ $j != $#$l && !$w->{mcc} ?
+ ('fill', 'fill', $w->{xpadding}, $w->{ypadding}) :
+ (['expand', 'fill'], ref($_) eq 'Gtk2::ScrolledWindow' || $_->get_data('must_grow') ?
+ ['expand', 'fill'] : [], 0, 0));
+ $_->show;
+ }
+ } @$l;
+ } @{delete $opts->{children} || []};
+
+ $w;
+}
+
+sub _gtk_any_simple {
+ my ($w, $_opts, $class) = @_;
+
+ $w ||= "Gtk2::$class"->new;
+}
+
+sub _gtknew_handle_children {
+ my ($w, $opts) = @_;
+
+ my @child = exists $opts->{children_tight} ? map { [ 0, $_ ] } @{delete $opts->{children_tight}} :
+ exists $opts->{children_loose} ? map { [ 1, $_ ] } @{delete $opts->{children_loose}} :
+ exists $opts->{children} ? group_by2(@{delete $opts->{children}}) :
+ exists $opts->{children_centered} ?
+ ([ 1, gtknew('VBox') ], (map { [ 0, $_ ] } @{delete $opts->{children_centered}}), [ 1, gtknew('VBox') ]) :
+ ();
+
+ my $padding = delete $opts->{padding};
+
+ foreach (@child) {
+ my ($fill, $child) = @$_;
+ $fill eq '0' || $fill eq '1' || $fill eq 'fill' || $fill eq 'expand' or internal_error("odd {children} parameter must be 0 or 1 (got $fill)");
+ ref $child or $child = Gtk2::WrappedLabel->new($child);
+ my $expand = $fill && $fill ne 'fill' ? 1 : 0;
+ $w->pack_start($child, $expand, $fill, $padding || 0);
+ $child->show;
+ }
+}
+
+#- this magic function redirects method calls:
+#- * default is to redirect them to the {child}
+#- * if the {child} doesn't handle the method, we try with the {real_window}
+#- (eg : add_accel_group set_position set_default_size
+#- * a few methods are handled specially
+my %for_real_window = map { $_ => 1 } qw(show_all size_request);
+sub mygtk2::MagicWindow::AUTOLOAD {
+ my ($w, @args) = @_;
+
+ my ($meth) = $mygtk2::MagicWindow::AUTOLOAD =~ /mygtk2::MagicWindow::(.*)/;
+
+ my ($s1, @s2) = $meth eq 'show'
+ ? ('real_window', 'banner', 'child') :
+ $meth eq 'destroy' || $meth eq 'hide' ?
+ ($w->{pop_it} ? 'real_window' : ('child', 'banner')) :
+ $meth eq 'get' && $args[0] eq 'window-position' ||
+ $for_real_window{$meth} ||
+ !$w->{child}->can($meth)
+ ? 'real_window'
+ : 'child';
+
+#- warn "mygtk2::MagicWindow::$meth", first($w =~ /HASH(.*)/), " on $s1 @s2 (@args)\n";
+
+ $w->{$_} && $w->{$_}->$meth(@args) foreach @s2;
+ $w->{$s1}->$meth(@args);
+}
+
+my $enable_quit_popup;
+sub enable_quit_popup {
+ my ($bool) = @_;
+ $enable_quit_popup = $bool;
+}
+
+state $in_callback;
+sub quit_popup() {
+ return if !$enable_quit_popup;
+ if (!$in_callback) {
+ $in_callback = 1;
+ my $_guard = before_leaving { undef $in_callback };
+ require ugtk2;
+ my $w = ugtk2->new(N("Confirmation"), grab => 1);
+ ugtk2::_ask_okcancel($w, N("Are you sure you want to quit?"), N("Quit"), N("Cancel"));
+ my $ret = ugtk2::main($w);
+ return 1 if !$ret;
+ }
+}
+
+sub quit_callback {
+ my ($w) = @_;
+
+ return 1 if quit_popup();
+ if ($::isWizard) {
+ $w->destroy;
+ die 'wizcancel';
+ } else {
+ if (Gtk2->main_level) {
+ Gtk2->main_quit;
+ } else {
+ # block window deletion if not in main loop (eg: while starting the GUI)
+ return 1;
+ }
+ }
+}
+
+sub _create_Window {
+ my ($opts, $special_center) = @_;
+
+ my $no_Window_Manager = exists $opts->{no_Window_Manager} ? delete $opts->{no_Window_Manager} : !$::isStandalone;
+
+ add2hash($opts, {
+ if_(!$::isInstall && !$::isWizard, border_width => 5),
+
+ #- policy: during install, we need a special code to handle the weird centering, see below
+ position_policy => $special_center ? 'none' :
+ $no_Window_Manager ? 'center-always' : 'center-on-parent',
+
+ if_($::isInstall, position => [
+ $::stepswidth + ($::o->{windowwidth} - $::real_windowwidth) / 2,
+ ($::o->{windowheight} - $::real_windowheight) / 2,
+ ]),
+ });
+ my $w = _gtk(undef, 'Window', 'gtknew', $opts);
+
+ #- when the window is closed using the window manager "X" button (or alt-f4)
+ $w->signal_connect(delete_event => \&quit_callback);
+
+ if ($::isInstall && !$::isStandalone) {
+ require install::gtk; #- for perl_checker
+ install::gtk::handle_unsafe_mouse($::o, $w);
+ $w->signal_connect(key_press_event => \&install::gtk::special_shortcuts);
+
+ #- force center at a weird position, this can't be handled by position_policy
+ #- because center-* really are window manager hints for centering, whereas we want
+ #- to center the main window in the right part of the screen
+ my ($wi, $he);
+ $w->signal_connect(size_allocate => sub {
+ my (undef, $event) = @_;
+ my @w_size = $event->values;
+
+ # ignore bogus sizing events:
+ return if $w_size[2] < 5;
+ return if $w_size[2] == $wi && $w_size[3] == $he; #BUG
+ (undef, undef, $wi, $he) = @w_size;
+
+ $w->move(max(0, $::rootwidth - ($::o->{windowwidth} + $wi) / 2),
+ max(0, ($::o->{windowheight} - $he) / 2));
+ }) if $special_center;
+ }
+
+ $w->present if $no_Window_Manager;
+
+ $w;
+}
+
+sub _find_imgfile {
+ my ($name) = @_;
+
+ if ($name =~ m|/| && -f $name) {
+ $name;
+ } else {
+ foreach my $path (_icon_paths()) {
+ foreach ('', '.png', '.xpm', '.jpg') {
+ my $file = "$path/$name$_";
+ -f $file and return $file;
+ }
+ }
+ }
+}
+
+# _text_insert() can be used with any of choose one of theses styles:
+# - no tags:
+# _text_insert($textview, "My text..");
+# - anonymous tags:
+# _text_insert($textview, [ [ 'first text', { 'foreground' => 'blue', 'background' => 'green', ... } ],
+# [ 'second text' ],
+# [ 'third', { 'font' => 'Serif 15', ... } ],
+# ... ]);
+# - named tags:
+# $textview->{tags} = {
+# 'blue_green' => { 'foreground' => 'blue', 'background' => 'green', ... },
+# 'big_font' => { 'font' => 'Serif 35', ... },
+# }
+# _text_insert($textview, [ [ 'first text', 'blue_green' ],
+# [ 'second', 'big_font' ],
+# ... ]);
+# - mixed anonymous and named tags:
+# $textview->{tags} = {
+# 'blue_green' => { 'foreground' => 'blue', 'background' => 'green', ... },
+# 'big_font' => { 'font' => 'Serif 35', ... },
+# }
+# _text_insert($textview, [ [ 'first text', 'blue_green' ],
+# [ 'second text' ],
+# [ 'third', 'big_font' ],
+# [ 'fourth', { 'font' => 'Serif 15', ... } ],
+# ... ]);
+sub _text_insert {
+ my ($textview, $t, %opts) = @_;
+ my $buffer = $textview->get_buffer;
+ $buffer->{tags} ||= {};
+ $buffer->{gtk_tags} ||= {};
+ my $gtk_tags = $buffer->{gtk_tags};
+ my $tags = $buffer->{tags};
+ if (ref($t) eq 'ARRAY') {
+ if (!$opts{append}) {
+ $buffer->set_text('');
+ $textview->{anchors} = [];
+ }
+ foreach my $token (@$t) {
+ my ($item, $tag) = @$token;
+ my $iter1 = $buffer->get_end_iter;
+ if (ref($item) =~ /^Gtk2::Gdk::Pixbuf/) {
+ $buffer->insert_pixbuf($iter1, $item);
+ next;
+ }
+ if (ref($item) =~ /^Gtk2::/) {
+ my $anchor = $buffer->create_child_anchor($iter1);
+ $textview->add_child_at_anchor($item, $anchor);
+ $textview->{anchors} ||= [];
+ push @{$textview->{anchors}}, $anchor;
+ next;
+ }
+ if ($tag) {
+ if (ref($tag)) {
+ # use anonymous tags
+ $buffer->insert_with_tags($iter1, $item, $buffer->create_tag(undef, %$tag));
+ } else {
+ # fast text insertion:
+ # since in some contexts (eg: localedrake, rpmdrake), we use quite a lot of identical tags,
+ # it's much more efficient and less memory pressure to use named tags
+ $gtk_tags->{$tag} ||= $buffer->create_tag($tag, %{$tags->{$token->[1]}});
+ $buffer->insert_with_tags($iter1, $item, $gtk_tags->{$tag});
+ }
+ } else {
+ $buffer->insert($iter1, $item);
+ }
+ }
+ } else {
+ if ($opts{append}) {
+ $buffer->insert($buffer->get_end_iter, $t);
+ } else {
+ $textview->{anchors} = [];
+ $buffer->set_text($t);
+ }
+ }
+ $textview->{to_bottom}->() if $textview->{to_bottom};
+
+ #- the following line is needed to move the cursor to the beginning, so that if the
+ #- textview has a scrollbar, it will not scroll to the bottom when focusing (#3633)
+ $buffer->place_cursor($buffer->get_start_iter);
+ $textview->set_wrap_mode($opts{wrap_mode} || 'word');
+ $textview->set_editable($opts{editable} || 0);
+ $textview->set_cursor_visible($opts{visible} || 0);
+ $textview;
+}
+
+sub _allow_scroll_TextView_to_bottom {
+ my ($scrolledWindow, $textView) = @_;
+
+ $textView->get_buffer->create_mark('end', $textView->get_buffer->get_end_iter, 0);
+ sub {
+ my ($o_force) = @_;
+ my $adjustment = $scrolledWindow->get_vadjustment;
+ if ($o_force || $adjustment->page_size + $adjustment->value == $adjustment->upper) {
+ flush(); #- one must flush before scrolling to end, otherwise the text just added *may* not be taken into account correctly, and so it doesn't really scroll to end
+ $textView->scroll_to_mark($textView->get_buffer->get_mark('end'), 0, 1, 0, 1);
+ }
+ };
+}
+
+sub asteriskize {
+ my ($label) = @_;
+ "\x{2022} " . $label;
+}
+
+sub get_main_window_size() {
+ $::real_windowwidth ? ($::real_windowwidth, $::real_windowheight) : $::isWizard ? (540, 360) : (600, 400);
+}
+
+# in order to workaround infamous 6 years old gnome bug #101968:
+sub get_label_width() {
+ first(mygtk2::get_main_window_size()) - 55 - $left_padding;
+}
+
+sub set_main_window_size {
+ my ($window) = @_;
+ my ($width, $height) = get_main_window_size();
+ $window->set_size_request($width, $height);
+}
+
+my @icon_paths;
+sub add_icon_path { push @icon_paths, @_ }
+sub _icon_paths() {
+ (@icon_paths, (exists $ENV{SHARE_PATH} ? ($ENV{SHARE_PATH}, "$ENV{SHARE_PATH}/icons", "$ENV{SHARE_PATH}/libDrakX/pixmaps") : ()),
+ "/usr/lib/libDrakX/icons", "pixmaps", 'data/icons', 'data/pixmaps', 'standalone/icons', '/usr/share/rpmdrake/icons');
+}
+
+sub main {
+ my ($window, $o_verif) = @_;
+ my $destroyed;
+ $window->signal_connect(destroy => sub { $destroyed = 1 });
+ $window->show;
+ do { Gtk2->main } while (!$destroyed && $o_verif && !$o_verif->());
+ may_destroy($window);
+ flush();
+}
+
+sub sync {
+ my ($window) = @_;
+ $window->show;
+ flush();
+}
+
+sub flush() {
+ Gtk2->main_iteration while Gtk2->events_pending;
+}
+
+sub enable_sync_flush {
+ my ($w) = @_;
+ $w->signal_connect(expose_event => sub { $w->{displayed} = 1; 0 });
+}
+
+sub sync_flush {
+ my ($w) = @_;
+ # hackish :-(
+ mygtk2::sync($w) while !$w->{displayed};
+}
+
+
+sub register_main_window {
+ my ($w) = @_;
+ push @::main_windows, $::main_window = $w;
+}
+
+sub may_destroy {
+ my ($w) = @_;
+ return if !$w;
+ @::main_windows = difference2(\@::main_windows, [ $w->{real_window} ]);
+ if ($::main_window eq $w->{real_window}) {
+ undef $::main_window;
+ $::main_window = $::main_windows[-1];
+ }
+ $w->destroy;
+}
+
+sub root_window() {
+ state $root;
+ $root ||= Gtk2::Gdk->get_default_root_window;
+}
+
+sub rgb2color {
+ my ($r, $g, $b) = @_;
+ my $color = Gtk2::Gdk::Color->new($r, $g, $b);
+ root_window()->get_colormap->rgb_find_color($color);
+ $color;
+}
+
+sub set_root_window_background {
+ my ($r, $g, $b) = @_;
+ my $root = root_window();
+ my $gc = Gtk2::Gdk::GC->new($root);
+ my $color = rgb2color($r, $g, $b);
+ $gc->set_rgb_fg_color($color);
+ set_root_window_background_with_gc($gc);
+}
+
+sub set_root_window_background_with_gc {
+ my ($gc) = @_;
+ my $root = root_window();
+ my ($w, $h) = $root->get_size;
+ $root->set_background($gc->get_values->{foreground});
+ $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
+}
+
+sub _new_alpha_pixbuf {
+ my ($pixbuf) = @_;
+ my ($height, $width) = ($pixbuf->get_height, $pixbuf->get_width);
+ my $new_pixbuf = Gtk2::Gdk::Pixbuf->new('rgb', 1, 8, $width, $height);
+ $new_pixbuf->fill(0x00000000); # transparent white
+ $width, $height, $new_pixbuf;
+}
+
+sub _pixbuf_render_alpha {
+ my ($pixbuf, $alpha_threshold) = @_;
+ my ($width, $height, $new_pixbuf) = _new_alpha_pixbuf($pixbuf);
+ $pixbuf->composite($new_pixbuf, 0, 0, $width, $height, 0, 0, 1, 1, 'bilinear', $alpha_threshold);
+ $new_pixbuf;
+}
+
+sub pixmap_from_pixbuf {
+ my ($widget, $pixbuf) = @_;
+ my $window = $widget->window or internal_error("you can't use this function if the widget is not realised");
+ my ($width, $height) = ($pixbuf->get_width, $pixbuf->get_height);
+ my $pixmap = Gtk2::Gdk::Pixmap->new($window, $width, $height, $window->get_depth);
+ $pixbuf->render_to_drawable($pixmap, $widget->style->fg_gc('normal'), 0, 0, 0, 0, $width, $height, 'max', 0, 0);
+ $pixmap;
+}
+
+sub import_style_ressources() {
+ if (!$::isInstall) {
+ Gtk2::Rc->parse_string(scalar cat_('/usr/share/libDrakX/themes-galaxy.rc')); # FIXME DEBUG
+ }
+}
+
+sub text_direction_rtl() {
+ Gtk2::Widget->get_default_direction eq 'rtl';
+}
+
+sub _get_weakness_icon {
+ my ($password_weakness) = @_;
+ my %weakness_icon = (
+ 1 => gtknew('Pixbuf', file => 'security-low'),
+ 2 => gtknew('Pixbuf', file => 'security-low'),
+ 3 => gtknew('Pixbuf', file => 'security-medium'),
+ 4 => gtknew('Pixbuf', file => 'security-strong'),
+ 5 => gtknew('Pixbuf', file => 'security-strong'));
+ my $weakness_icon = $weakness_icon{$password_weakness} || return undef;
+ $weakness_icon;
+}
+
+sub _get_weakness_tooltip {
+ my ($password_weakness) = @_;
+ my %weakness_tooltip = (
+ 1 => N("Password is trivial to guess"),
+ 2 => N("Password is trivial to guess"),
+ 3 => N("Password should be resistant to basic attacks"),
+ 4 => N("Password seems secure"),
+ 5 => N("Password seems secure"));
+ my $weakness_tooltip = $weakness_tooltip{$password_weakness} || return undef;
+ return $weakness_tooltip;
+}
+
+package Gtk2::MDV_Notebook; # helper functions for installer & mcc
+our @ISA = qw(Gtk2::Widget);
+
+sub hide_selection {
+ my ($w) = @_;
+ $_->hide foreach $w->{selection_bar}, $w->{selection_arrow};
+}
+
+sub move_selection {
+ my ($w, $label) = @_;
+ my $layout = $w->{layout};
+ $layout->{arrow_ydiff} ||=
+ ($w->{selection_arrow}->get_pixbuf->get_height - $w->{selection_bar}->get_pixbuf->get_height)/2;
+ my $bar_y = $label->allocation->y - ($w->{selection_bar}->get_pixbuf->get_height - $label->allocation->height)/2;
+ $layout->move($w->{selection_bar}, 0, $bar_y);
+ $layout->move($w->{selection_arrow}, $w->{arrow_x}, $bar_y - $layout->{arrow_ydiff}); # arrow is higer
+ $_->show foreach $w->{selection_bar}, $w->{selection_arrow};
+}
+
+1;
diff --git a/perl-install/ugtk2.pm b/perl-install/ugtk2.pm
new file mode 100644
index 000000000..3db9ff814
--- /dev/null
+++ b/perl-install/ugtk2.pm
@@ -0,0 +1,1652 @@
+package ugtk2;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @icon_paths $wm_icon $grab $border); #- leave it on one line, for automatic removal of the line at package creation
+use locale;
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+ wrappers => [ qw(gtkadd gtkadd_widget gtkappend gtkappend_page gtkappenditems gtkcombo_setpopdown_strings gtkdestroy
+ gtkentry gtkflush gtkhide gtkmodify_font gtkmove gtkpack gtkpack2 gtkpack2_
+ gtkpack2__ gtkpack_ gtkpack__ gtkpowerpack gtkput gtkradio gtkresize gtkroot
+ gtkset_active gtkset_border_width gtkset_editable gtkset_justify gtkset_alignment gtkset_layout gtkset_line_wrap
+ gtkset_markup gtkset_modal gtkset_mousecursor gtkset_mousecursor_normal gtkset_mousecursor_wait gtkset_name
+ gtkset_property gtkset_relief gtkset_selectable gtkset_sensitive gtkset_shadow_type gtkset_size_request
+ gtkset_text gtkset_tip gtkset_visibility gtksetstyle gtkshow gtksignal_connect gtksize gtktext_append
+ gtktext_insert ) ],
+
+ helpers => [ qw(add2notebook add_icon_path escape_text_for_TextView_markup_format gtkcolor gtkcreate_img
+ gtkcreate_pixbuf gtkfontinfo gtkset_background gtktreeview_children set_back_pixmap
+ get_default_step_items set_default_step_items
+ string_size string_width) ],
+
+ create => [ qw(create_adjustment create_box_with_title create_dialog create_factory_menu create_factory_popup_menu
+ create_hbox create_hpaned create_menu create_notebook create_okcancel create_packtable
+ create_scrolled_window create_vbox create_vpaned _create_dialog gtkcreate_frame) ],
+
+ ask => [ qw(ask_browse_tree_info ask_browse_tree_info_given_widgets ask_dir ask_from_entry ask_okcancel ask_warn
+ ask_yesorno) ],
+ dialogs => [ qw(err_dialog info_dialog warn_dialog) ],
+
+);
+$EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+use c;
+use log;
+use common;
+use mygtk2 qw(gtknew); #- do not import gtkadd which conflicts with ugtk2 version
+
+use Gtk2;
+
+
+$border = 5;
+
+sub wm_icon() { $wm_icon || $::Wizard_pix_up || "wiz_default_up.png" }
+
+# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---
+# wrappers
+#
+# Functional-style wrappers to existing Gtk functions; allows to program in
+# a more functional way, and especially, first, to avoid using temp
+# variables, and second, to "see" directly in the code the user interface
+# you're building.
+
+sub gtkdestroy { mygtk2::may_destroy($_[0]) }
+sub gtkflush() { mygtk2::flush() }
+sub gtkhide { $_[0]->hide; $_[0] }
+sub gtkmove { $_[0]->window->move($_[1], $_[2]); $_[0] }
+sub gtkpack { gtkpowerpack(1, 1, @_) }
+sub gtkpack_ { gtkpowerpack('arg', 1, @_) }
+sub gtkpack__ { gtkpowerpack(0, 1, @_) }
+sub gtkpack2 { gtkpowerpack(1, 0, @_) }
+sub gtkpack2_ { gtkpowerpack('arg', 0, @_) }
+sub gtkpack2__ { gtkpowerpack(0, 0, @_) }
+sub gtkput { $_[0]->put(gtkshow($_[1]), $_[2], $_[3]); $_[0] }
+sub gtkresize { $_[0]->window->resize($_[1], $_[2]); $_[0] }
+sub gtkset_active { $_[0]->set_active($_[1]); $_[0] }
+sub gtkset_border_width { $_[0]->set_border_width($_[1]); $_[0] }
+sub gtkset_editable { $_[0]->set_editable($_[1]); $_[0] }
+sub gtkset_selectable { $_[0]->set_selectable($_[1]); $_[0] }
+sub gtkset_justify { $_[0]->set_justify($_[1]); $_[0] }
+sub gtkset_alignment { $_[0]->set_alignment($_[1], $_[2]); $_[0] }
+sub gtkset_layout { $_[0]->set_layout($_[1]); $_[0] }
+sub gtkset_modal { $_[0]->set_modal($_[1]); $_[0] }
+sub gtkset_mousecursor_normal { gtkset_mousecursor('left-ptr', @_) }
+sub gtkset_mousecursor_wait { gtkset_mousecursor('watch', @_) }
+sub gtkset_relief { $_[0]->set_relief($_[1]); $_[0] }
+sub gtkset_sensitive { $_[0]->set_sensitive($_[1]); $_[0] }
+sub gtkset_visibility { $_[0]->set_visibility($_[1]); $_[0] }
+sub gtkset_tip { $_[0]->set_tip($_[1], $_[2]) if $_[2]; $_[1] }
+sub gtkset_shadow_type { $_[0]->set_shadow_type($_[1]); $_[0] }
+sub gtkset_style { $_[0]->set_style($_[1]); $_[0] }
+sub gtkset_size_request { $_[0]->set_size_request($_[1], $_[2]); $_[0] }
+sub gtkshow { $_[0]->show; $_[0] }
+sub gtksize { $_[0]->size($_[1], $_[2]); $_[0] }
+sub gtkset_markup { $_[0]->set_markup($_[1]); $_[0] }
+sub gtkset_line_wrap { $_[0]->set_line_wrap($_[1]); $_[0] }
+
+sub gtkadd {
+ my $w = shift;
+ foreach my $l (@_) {
+ ref $l or $l = gtknew('WrappedLabel', text => $l);
+ $w->add(gtkshow($l));
+ }
+ $w;
+}
+
+sub gtkadd_widget {
+ my $sg = shift;
+ map {
+ my $l = $_;
+ ref $l or $l = gtknew('WrappedLabel', text => $l);
+ $sg->add_widget($l);
+ $l;
+ } @_;
+}
+
+sub gtkappend {
+ my $w = shift;
+ foreach my $l (@_) {
+ ref $l or $l = gtknew('WrappedLabel', text => $l);
+ $w->append(gtkshow($l));
+ }
+ $w;
+}
+
+sub gtkappenditems {
+ my $w = shift;
+ $_->show foreach @_;
+ $w->append_items(@_);
+ $w;
+}
+
+# append page to a notebook
+sub gtkappend_page {
+ my ($notebook, $page, $o_title) = @_;
+ $notebook->append_page($page, $o_title);
+ $notebook;
+}
+
+sub gtkentry {
+ my ($o_text) = @_;
+ my $e = gtknew('Entry');
+ $o_text and $e->set_text($o_text);
+ $e;
+}
+
+sub gtksetstyle {
+ my ($w, $s) = @_;
+ $w->set_style($s);
+ $w;
+}
+
+sub gtkradio {
+ my $def = shift;
+ my $radio;
+ map {
+ my $w = gtkset_active($radio = Gtk2::RadioButton->new_with_label($radio ? $radio->get_group : undef, $_), $_ eq $def);
+ $w->get_child->set_line_wrap(1);
+ $w;
+ } @_;
+}
+
+sub gtkroot() { mygtk2::root_window() }
+sub gtkcolor { &mygtk2::rgb2color }
+sub gtkset_background { &mygtk2::set_root_window_background }
+
+sub gtkset_text {
+ my ($w, $s) = @_;
+ $w->set_text($s);
+ $w;
+}
+
+sub gtkcombo_setpopdown_strings {
+ my $w = shift;
+ $w->set_popdown_strings(@_);
+ $w;
+}
+
+sub gtkset_mousecursor {
+ my ($type, $w) = @_;
+ ($w || gtkroot())->set_cursor(Gtk2::Gdk::Cursor->new($type));
+ $w;
+}
+
+sub gtksignal_connect {
+ my $w = shift;
+ $w->signal_connect(@_);
+ $w;
+}
+
+sub gtkset_name {
+ my ($widget, $name) = @_;
+ $widget->set_name($name);
+ $widget;
+}
+
+
+sub gtkpowerpack {
+ #- Get Default Attributes (if any). 2 syntaxes allowed :
+ #- gtkpowerpack( {expand => 1, fill => 0}, $box...) : the attributes are picked from a specified hash ref
+ #- gtkpowerpack(1, 0, 1, $box, ...) : the attributes are picked from the non-ref list, in the order (expand, fill, padding, pack_end).
+ my @attributes_list = qw(expand fill padding pack_end);
+ my $default_attrs = {};
+ if (ref($_[0]) eq 'HASH') {
+ $default_attrs = shift;
+ } elsif (!ref($_[0])) {
+ foreach (@attributes_list) {
+ ref($_[0]) and last;
+ $default_attrs->{$_} = shift;
+ }
+ }
+ my $box = shift;
+
+ while (@_) {
+ #- Get attributes (if specified). 4 syntaxes allowed (default values are undef ie. false...) :
+ #- gtkpowerpack({defaultattrs}, $box, $widget1, $widget2, ...) : the attrs are picked from the default ones (if they exist)
+ #- gtkpowerpack($box, {fill=>1, expand=>0, ...}, $widget1, ...) : the attributes are picked from a specified hash ref
+ #- gtkpowerpack($box, [1,0,1], $widget1, ...) : the attributes are picked from the array ref : (expand, fill, padding, pack_end).
+ #- gtkpowerpack({attr=>'arg'}, $box, 1, $widget1, 0, $widget2, etc...) : the 'arg' value will tell gtkpowerpack to always read the
+ #- attr value directly in the arg list (avoiding confusion between value 0 and Gtk::Label("0"). That can simplify some writings but
+ #- this arg(s) MUST then be present...
+ my (%attr, $attrs);
+ ref($_[0]) eq 'HASH' || ref($_[0]) eq 'ARRAY' and $attrs = shift;
+ foreach (@attributes_list) {
+ if (($default_attrs->{$_} || '') eq 'arg') {
+ ref($_[0]) and internal_error "error in packing definition\n";
+ $attr{$_} = shift;
+ ref($attrs) eq 'ARRAY' and shift @$attrs;
+ } elsif (ref($attrs) eq 'HASH' && defined($attrs->{$_})) {
+ $attr{$_} = $attrs->{$_};
+ } elsif (ref($attrs) eq 'ARRAY') {
+ $attr{$_} = shift @$attrs;
+ } elsif (defined($default_attrs->{$_})) {
+ $attr{$_} = int $default_attrs->{$_};
+ } else {
+ $attr{$_} = 0;
+ }
+ }
+ #- Get and pack the widget (create it if necessary to a label...)
+ my $widget = ref($_[0]) ? shift : gtknew('WrappedLabel', text => shift);
+ my $pack_call = 'pack_' . ($attr{pack_end} ? 'end' : 'start');
+ $box->$pack_call($widget, $attr{expand}, $attr{fill}, $attr{padding});
+ $widget->show;
+ }
+ return $box;
+}
+
+sub gtktreeview_children {
+ my ($model, $iter) = @_;
+ my @l;
+ $model or return;
+ for (my $p = $model->iter_children($iter); $p; $p = $model->iter_next($p)) {
+ push @l, $p;
+ }
+ @l;
+}
+
+
+
+# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---
+# create
+#
+# Helpers that allow omitting common operations on common widgets
+# (e.g. create widgets with good default properties)
+
+sub create_pixbutton {
+ my ($label, $pix, $reverse_order) = @_;
+ my @label_and_pix = (0, $label, if_($pix, 0, $pix));
+ gtkadd(gtknew('Button'),
+ gtknew('HBox', spacing => 3, children => [
+ 1, "",
+ $reverse_order ? reverse(@label_and_pix) : @label_and_pix,
+ 1, "",
+ ]));
+}
+
+sub create_adjustment {
+ my ($val, $min, $max) = @_;
+ Gtk2::Adjustment->new($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1);
+}
+
+sub create_scrolled_window {
+ my ($W, $o_policy, $o_viewport_shadow) = @_;
+ gtknew('ScrolledWindow', ($o_policy ? (h_policy => $o_policy->[0], v_policy => $o_policy->[1]) : ()),
+ child => $W, if_($o_viewport_shadow, shadow_type => $o_viewport_shadow));
+}
+
+sub n_line_size {
+ my ($nbline, $type, $widget) = @_;
+ my $spacing = ${{ text => 3, various => 17 }}{$type};
+ my %fontinfo = gtkfontinfo($widget);
+ round($nbline * ($fontinfo{ascent} + $fontinfo{descent} + $spacing) + 8);
+}
+
+# Glib::Markup::escape_text() if no use for us because it'll do extra
+# s/X/&foobar;/ (such as s/'/&apos;/) that are suitable for
+# Gtk2::Labels but are not for Gtk2::TextViews, resulting in
+# displaying the raw enriched text instead...
+#
+sub escape_text_for_TextView_markup_format {
+ my ($str) = @_;
+ my %rules = ('&' => '&amp;',
+ '<' => '&lt;',
+ '>' => '&gt;',
+ );
+ eval { $str =~ s!([&<>])!$rules{$1}!g }; #^(&(amp|lt|gt);)!!) {
+ if (my $err = $@) {
+ internal_error("$err\n$str");
+ }
+ $str;
+}
+
+sub markup_to_TextView_format {
+ my ($s, $o_default_attrs) = @_;
+ require interactive;
+ my $l = interactive::markup_parse($s) or return $s;
+
+ foreach (@$l) {
+ my ($_txt, $attrs) = @$_;
+ if ($attrs) {
+ $attrs->{weight} eq 'bold' and $attrs->{weight} = do { require Gtk2::Pango; Gtk2::Pango->PANGO_WEIGHT_BOLD };
+ $attrs->{size} eq 'larger' and do {
+ $attrs->{scale} = Gtk2::Pango->scale_x_large; # equivalent to Label's size => 'larger'
+ delete $attrs->{size};
+ };
+ }
+ #- nb: $attrs may be empty, need special handling if $o_default_attrs is used
+ add2hash_($_->[1] ||= {}, $o_default_attrs) if $o_default_attrs;
+ }
+ $l;
+}
+
+sub create_box_with_title {
+ my ($o, @l) = @_;
+
+ my $nbline = sum(map { round(length($_) / 60 + 1/2) } map { split "\n" } @l);
+ my $box = gtknew('VBox');
+ if ($nbline == 0) {
+ $o->{box_size} = 0;
+ return $box;
+ }
+ $o->{box_size} = n_line_size($nbline, 'text', $box);
+ if (@l <= 2 && $nbline > 4) {
+ $o->{icon} && !$::isWizard and
+ eval { gtkpack__($box, gtknew('HBox', border_width => 5, children_loose => [ gtkcreate_img($o->{icon}) ])) };
+ my $wanted = $o->{box_size};
+ $o->{box_size} = min(200, $o->{box_size});
+ my $has_scroll = $o->{box_size} < $wanted;
+
+ chomp(my $text = join("\n", @l));
+ my $wtext = gtknew('TextView', text => markup_to_TextView_format($text));
+ $wtext->set_justification('fill');
+ $wtext->set_left_margin(12);
+ $wtext->set_right_margin(12);
+ $wtext->can_focus($has_scroll);
+ my $width = 400;
+ my $scroll = gtknew('ScrolledWindow', child => $wtext, width => $width, height => 200);
+ $scroll->signal_connect(realize => sub {
+ my $layout = $wtext->create_pango_layout($text);
+ $layout->set_width(($width - 10) * Gtk2::Pango->scale);
+ $wtext->set_size_request($width, min(200, second($layout->get_pixel_size) + 10));
+ $scroll->set_size_request($width, min(200, second($layout->get_pixel_size) + 10));
+ $o->{rwindow}->queue_resize;
+ });
+ gtkpack_($box, $o->{box_allow_grow} || 0, $scroll);
+ } else {
+ my $new_label = sub {
+ my ($txt) = @_;
+ ref($txt) ? $txt : gtknew('WrappedLabel', text_markup => $txt,
+ # workaround infamous 6 years old gnome bug #101968:
+ width => mygtk2::get_label_width());
+ };
+ gtkpack__($box,
+ if_($::isWizard, gtknew('Label', height => 10)),
+ (map {
+ my $w = $new_label->($_);
+ $::isWizard ? gtknew('HBox', children_tight => [ gtknew('Label', width => 20), $w ])
+ : $w;
+ } @l),
+ if_($::isWizard, gtknew('Label', height => 15)),
+ );
+ }
+}
+
+sub _create_dialog {
+ my ($title, $o_options) = @_;
+ my $options = $o_options || {};
+
+ #- keep compatibility with "transient" now called "transient_for"
+ $options->{transient_for} = delete $options->{transient} if $options->{transient};
+
+ gtknew('Dialog', title => $title,
+ position_policy => 'center-on-parent', # center-on-parent does not work
+ modal => 1,
+ if_(!$::isInstall, icon_no_error => wm_icon()),
+ %$options, allow_unknown_options => 1,
+ );
+}
+
+
+# drakfloppy / drakfont / harddrake2 / mcc
+sub create_dialog {
+ my ($title, $label, $o_options) = @_;
+ my $ret = 0;
+ $o_options ||= {};
+ $o_options->{transient_for} = $::main_window if !$o_options->{transient_for} && $::main_window;
+
+ my $dialog = gtkset_border_width(_create_dialog($title, $o_options), 10);
+ $dialog->set_border_width(10);
+ my $text = ref($label) ? $label : $o_options->{use_markup} ? gtknew('WrappedLabel', text_markup => $label) : gtknew('WrappedLabel', text => $label);
+ gtkpack($dialog->vbox,
+ gtknew('HBox', children => [
+ if_($o_options->{stock},
+ 0, Gtk2::Image->new_from_stock($o_options->{stock}, 'dialog'),
+ 0, gtknew('Label', text => " "),
+ ),
+ 1, $o_options->{scroll} ? create_scrolled_window($text, [ 'never', 'automatic' ]) : $text,
+ ]),
+ );
+
+ if ($o_options->{cancel}) {
+ $dialog->action_area->pack_start(
+ gtknew('Button', text => N("Cancel"),
+ clicked => sub { $ret = 0; $dialog->destroy; Gtk2->main_quit },
+ can_default => 1),
+ 1, 1, 0);
+ }
+
+ my $button = gtknew('Button', text => N("Ok"), can_default => 1,
+ clicked => sub { $ret = 1; $dialog->destroy; Gtk2->main_quit });
+ $dialog->action_area->pack_start($button, 1, 1, 0);
+ $button->grab_default;
+
+ $dialog->set_has_separator(0);
+ $dialog->show_all;
+ Gtk2->main;
+ $ret;
+}
+
+sub info_dialog {
+ my ($title, $label, $o_options) = @_;
+ $o_options ||= { };
+ add2hash_($o_options, { stock => 'gtk-dialog-info' });
+ create_dialog($title, $label, $o_options);
+}
+
+sub warn_dialog {
+ my ($title, $label, $o_options) = @_;
+ $o_options ||= { };
+ add2hash_($o_options, { stock => 'gtk-dialog-warning', cancel => 1 });
+ create_dialog($title, $label, $o_options);
+}
+
+sub err_dialog {
+ my ($title, $label, $o_options) = @_;
+ $o_options ||= { };
+ add2hash_($o_options, { stock => 'gtk-dialog-error' });
+ create_dialog($title, $label, $o_options);
+}
+
+sub create_hbox { gtknew('HButtonBox', layout => $_[0]) }
+sub create_vbox { gtknew('VButtonBox', layout => $_[0]) }
+
+sub create_factory_menu_ {
+ my ($type, $name, $window, @menu_items) = @_;
+ my $widget = Gtk2::ItemFactory->new($type, $name, my $accel_group = Gtk2::AccelGroup->new);
+ $widget->create_items($window, @menu_items);
+ $window->add_accel_group($accel_group);
+ ($widget->get_widget($name), $widget);
+}
+
+sub create_factory_popup_menu { create_factory_menu_("Gtk2::Menu", '<main>', @_) }
+sub create_factory_menu { create_factory_menu_("Gtk2::MenuBar", '<main>', @_) }
+
+sub create_menu {
+ my $title = shift;
+ my $w = Gtk2::MenuItem->new($title);
+ $w->set_submenu(gtkshow(gtkappend(Gtk2::Menu->new, @_)));
+ $w;
+}
+
+sub create_notebook {
+ my $book = gtknew('Notebook');
+ while (@_) {
+ my ($page, $title) = splice(@_, 0, 2);
+ gtkappend_page($book, $page, $title);
+ }
+ $book;
+}
+
+sub create_packtable {
+ my ($options, @l) = @_;
+ my $w = Gtk2::Table->new(0, 0, $options->{homogeneous} || 0);
+ add2hash_($options, { xpadding => 5, ypadding => 0 });
+ each_index {
+ my ($i, $l) = ($::i, $_);
+ each_index {
+ my $j = $::i;
+ if ($_) {
+ ref $_ or $_ = gtknew('WrappedLabel', text => $_);
+ $j != $#$l && !$options->{mcc} ?
+ $w->attach($_, $j, $j + 1, $i, $i + 1,
+ 'fill', 'fill', $options->{xpadding}, $options->{ypadding}) :
+ $w->attach($_, $j, $j + 1, $i, $i + 1,
+ ['expand', 'fill'], ref($_) eq 'Gtk2::ScrolledWindow' || $_->get_data('must_grow') ? ['expand', 'fill'] : [], 0, 0);
+ $_->show;
+ }
+ } @$l;
+ } @l;
+ $w->set_col_spacings($options->{col_spacings} || 0);
+ $w->set_row_spacings($options->{row_spacings} || 0);
+ gtkset_border_width($w, $::isInstall ? 3 : 10);
+}
+
+my $wm_is_kde;
+sub create_okcancel {
+ my ($w, $o_ok, $o_cancel, $_o_spread, @other) = @_;
+ # @other is a list of extra buttons (usually help (eg: XFdrake/drakx caller) or advanced (eg: interactive caller) button)
+ # extra buttons have the following structure [ label, handler, is_first, pack_right ]
+ local $::isWizard = $::isWizard && !$w->{pop_it};
+ my $cancel;
+ if (defined $o_cancel || defined $o_ok) {
+ $cancel = $o_cancel;
+ } elsif (!$::Wizard_no_previous) {
+ $cancel = $::isWizard ? N("Previous") : N("Cancel");
+ }
+ my $ok = defined $o_ok ? $o_ok : $::isWizard ? ($::Wizard_finished ? N("Finish") : N("Next")) : N("Ok");
+ my $bok = $ok && ($w->{ok} = gtknew('Button', text => $ok, clicked => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk2->main_quit }));
+ my $bprev;
+ if ($cancel) {
+ $bprev = $w->{cancel} = gtknew('Button', text => $cancel, clicked => $w->{cancel_clicked} ||
+ sub { log::l("default cancel_clicked"); undef $w->{retval}; Gtk2->main_quit });
+ }
+ $w->{wizcancel} = gtknew('Button', text => ($::Wizard_skip ? N("Skip") : N("Cancel")), clicked => sub { die 'wizcancel' }) if $::isWizard && !$::isInstall && !$::Wizard_no_cancel;
+ if (!defined $wm_is_kde) {
+ require any;
+ my $wm = any::running_window_manager();
+ $wm_is_kde = !$::isInstall && ($wm eq "kwin" || $wm eq "compiz" && fuzzy_pidofs(qr/\bkde-window-decorator\b/)) || 0;
+ }
+ my $f = sub { $w->{buttons}{$_[0][0]} = ref($_[0][0]) =~ /Gtk2::Button/ ?
+ $_[0][0] :
+ gtknew('Button', text => $_[0][0], clicked => $_[0][1]) };
+ my @left = ((map { $f->($_) } grep { $_->[2] && !$_->[3] } @other),
+ map { $f->($_) } grep { !$_->[2] && !$_->[3] } @other);
+ my @right = ((map { $f->($_) } grep { $_->[2] && $_->[3] } @other),
+ map { $f->($_) } grep { !$_->[2] && $_->[3] } @other);
+ # we put space to group buttons in two packs (but if there's only one when not in wizard mode)
+ # but in the installer where all windows run in wizard mode because of design even when not in a wizard step
+ $bprev = gtknew('Label') if !$cancel && $::Wizard_no_previous && !@left && !@right;
+ if ($::isWizard || $w->{pop_it}) {
+ # wizard mode: order is cancel/left_extras/white/right_extras/prev/next
+ unshift @left, $w->{wizcancel} if $w->{wizcancel};
+ push @right, $bprev, $bok;
+ } else {
+ # normal mode: cancel/ok button follow GNOME's HIG
+ unshift @left, ($wm_is_kde ? $bok : $bprev);
+ push @left, gtknew('Label') if $ok && $cancel; # space buttons but if there's only one button
+ push @right, ($wm_is_kde ? $bprev : $bok);
+ }
+
+ gtknew('VBox', spacing => 5, children_loose => [
+ gtknew('HBox', height => 5),
+ gtknew('HSeparator'),
+ gtknew('HBox', children_loose => [
+ map {
+ gtknew('HButtonBox', spacing => 5, layout => $_->[1],
+ children_loose => [
+ map {
+ $_->can_default($::isWizard);
+ $_;
+ } grep { $_ } @{$_->[0]}
+ ]);
+ } ([ \@left, 'start' ],
+ [ \@right, 'end' ],
+ )
+ ]),
+ ]);
+}
+
+sub _setup_paned {
+ my ($paned, $child1, $child2, %options) = @_;
+ foreach ([ 'resize1', 0 ], [ 'shrink1', 1 ], [ 'resize2', 1 ], [ 'shrink2', 1 ]) {
+ $options{$_->[0]} = $_->[1] unless defined($options{$_->[0]});
+ }
+ $paned->pack1(gtkshow($child1), $options{resize1}, $options{shrink1});
+ $paned->pack2(gtkshow($child2), $options{resize2}, $options{shrink2});
+ gtkshow($paned);
+}
+
+sub create_vpaned {
+ _setup_paned(Gtk2::VPaned->new, @_);
+}
+
+sub create_hpaned {
+ _setup_paned(Gtk2::HPaned->new, @_);
+}
+
+sub gtkcreate_frame {
+ my ($label) = @_;
+ gtknew('Frame', text => $label, border_width => 5);
+}
+
+
+# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---
+# helpers
+#
+# Functions that do typical operations on widgets, that you may need in
+# several places of your programs.
+
+sub _find_imgfile {
+ my ($name) = @_;
+
+ if ($name =~ m|/| && -f $name) {
+ $name;
+ } else {
+ foreach my $path (icon_paths()) {
+ foreach ('', '.png', '.xpm') {
+ my $file = "$path/$name$_";
+ -f $file and return $file;
+ }
+ }
+ }
+}
+
+# use it if you want to display an icon/image in your app
+sub gtkcreate_img {
+ my ($file, $o_size) = @_;
+ gtknew('Image', file => $file, if_($o_size, size => $o_size));
+}
+
+# use it if you want to draw an image onto a drawingarea
+sub gtkcreate_pixbuf {
+ my ($file, $o_size) = @_;
+ gtknew('Pixbuf', file => $file, if_($o_size, size => $o_size));
+}
+
+sub gtktext_append { gtktext_insert(@_, append => 1) }
+
+sub may_set_icon {
+ my ($w, $name) = @_;
+ if (my $f = $name && _find_imgfile($name)) {
+ $w->set_icon(gtkcreate_pixbuf($f));
+ }
+}
+
+sub gtktext_insert { &mygtk2::_text_insert }
+sub icon_paths { &mygtk2::_icon_paths }
+sub add_icon_path { &mygtk2::add_icon_path }
+
+sub set_main_window_size {
+ my ($o) = @_;
+ mygtk2::set_main_window_size($o->{rwindow});
+}
+
+# extracts interesting font metrics for a given widget
+sub gtkfontinfo {
+ my ($widget) = @_;
+ my $context = $widget->get_pango_context;
+ my $metrics = $context->get_metrics($context->get_font_description, $context->get_language);
+ my %fontinfo;
+ foreach (qw(ascent descent approximate_char_width approximate_digit_width)) {
+ no strict;
+ my $func = "get_$_";
+ $fontinfo{$_} = Gtk2::Pango->pixels($metrics->$func);
+ }
+ %fontinfo;
+}
+
+sub gtkmodify_font {
+ my ($w, $arg) = @_;
+ $w->modify_font(ref($arg) ? $arg : Gtk2::Pango::FontDescription->from_string($arg));
+ $w;
+}
+
+sub gtkset_property {
+ my ($w, $property, $value) = @_;
+ $w->set_property($property, $value);
+ $w;
+}
+
+sub set_back_pixbuf {
+ my ($widget, $pixbuf) = @_;
+ my $window = $widget->window;
+ my ($width, $height) = ($pixbuf->get_width, $pixbuf->get_height);
+ my $pixmap = Gtk2::Gdk::Pixmap->new($window, $width, $height, $window->get_depth);
+ $pixbuf->render_to_drawable($pixmap, $widget->style->fg_gc('normal'), 0, 0, 0, 0, $width, $height, 'max', 0, 0);
+ $window->set_back_pixmap($pixmap, 0);
+}
+
+sub set_back_pixmap {
+ my ($w) = @_;
+ return if !$w->realized;
+ my $window = $w->window;
+ my $pixmap = $w->{back_pixmap} ||= Gtk2::Gdk::Pixmap->new($window, 1, 2, $window->get_depth);
+
+ my $style = $w->get_style;
+ $pixmap->draw_points($style->bg_gc('normal'), 0, 0);
+ $pixmap->draw_points($style->base_gc('normal'), 0, 1);
+ $window->set_back_pixmap($pixmap);
+}
+
+sub add2notebook {
+ my ($n, $title, $book) = @_;
+ $n->append_page($book, gtkshow(gtknew('Label', text => $title)));
+ $book->show;
+}
+
+sub string_size {
+ my ($widget, $text) = @_;
+ my $layout = $widget->create_pango_layout($text);
+ my @size = $layout->get_pixel_size;
+ @size;
+}
+
+sub string_width {
+ my ($widget, $text) = @_;
+ my ($width, undef) = string_size($widget, $text);
+ $width;
+}
+
+
+my ($def_step_title);
+sub set_default_step_items {
+ $def_step_title = translate($_[0]);
+}
+
+sub get_default_step_items { ($def_step_title) }
+
+# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---
+# toplevel window creation helper
+#
+# Use the 'new' function as a method constructor and then 'main' on it to
+# launch the main loop. Use $o->{retval} to indicate that the window needs
+# to terminate.
+# Set $::isWizard to have a wizard appearance.
+# Set $::isEmbedded and $::XID so that the window will plug.
+
+sub new {
+ my ($type, $title, %opts) = @_;
+
+ my $o = bless { %opts }, $type;
+ while (my $e = shift @tempory::objects) { $e->destroy }
+
+ my $icon = find { _find_imgfile($_) } $::isInstall ? 'empty-banner' : $opts{icon};
+ my $banner_title = $opts{banner_title};
+ $o->{transient} ||= $::main_window if $::main_window && !$opts{do_not_track_main_window};
+ my $window = gtknew(
+ 'MagicWindow',
+ title => $title || '',
+ pop_it => $o->{pop_it},
+ $::isInstall ? (banner => gtknew('Install_Title', text => $title || get_default_step_items())) : (),
+ $::isStandalone && $banner_title && $icon ? (banner => Gtk2::Banner->new($icon, $banner_title)) : (),
+ width => $opts{width}, height => $opts{height}, default_width => $opts{default_width}, default_height => $opts{default_height},
+ modal => (!$o->{pop_it} && !$::isInstall) && ($opts{modal} || $grab || $o->{grab}) || $o->{modal},
+ no_Window_Manager => exists $opts{no_Window_Manager} ? $opts{no_Window_Manager} : !$::isStandalone,
+ if_(!$::isInstall, icon_no_error => wm_icon()),
+ if_($o->{transient}, transient_for => $o->{transient}),
+ );
+ mygtk2::register_main_window($window->{real_window}) if !$opts{do_not_track_main_window};
+ $window->set_border_width(10) if !$window->{pop_it} && !$::noborderWhenEmbedded;
+
+ $o->{rwindow} = $o->{window} = $window;
+ $o->{real_window} = $window->{real_window};
+ $o->{pop_it} = $window->{pop_it};
+
+ $o;
+}
+
+sub main {
+ my ($o, $o_completed, $o_canceled) = @_;
+ gtkset_mousecursor_normal();
+
+ $o->show;
+ mygtk2::main($o->{rwindow},
+ sub { $o->{retval} ? !$o_completed || $o_completed->() : !$o_canceled || $o_canceled->() });
+ $o->{retval};
+}
+sub show($) {
+ my ($o) = @_;
+ $o->{rwindow}->show;
+}
+sub destroy($) {
+ my ($o) = @_;
+ $o->{rwindow}->destroy;
+ flush();
+}
+sub DESTROY { goto &destroy }
+sub sync {
+ my ($o) = @_;
+ show($o);
+ flush();
+}
+sub flush() { gtkflush() }
+sub shrink_topwindow {
+ my ($o) = @_;
+ $o->{real_window}->signal_emit('size_allocate', Gtk2::Gdk::Rectangle->new(-1, -1, -1, -1));
+}
+sub exit {
+ gtkset_mousecursor_normal(); #- for restoring a normal in any case
+ flush();
+ if ($::isStandalone) {
+ require standalone;
+ standalone::__exit($_[1]); #- workaround
+ } else {
+ c::_exit($_[1]); #- workaround
+ }
+}
+
+#- in case "exit" above was not called by the program
+END { &exit() }
+
+# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---
+# ask
+#
+# Full UI managed functions that will return to you the value that the
+# user chose.
+
+sub ask_warn { my $w = ugtk2->new(shift @_, grab => 1); $w->_ask_warn(@_); main($w) }
+sub ask_yesorno { my $w = ugtk2->new(shift @_, grab => 1); $w->_ask_okcancel(@_, N("Yes"), N("No")); main($w) }
+sub ask_okcancel { my $w = ugtk2->new(shift @_, grab => 1); $w->_ask_okcancel(@_, N("Is this correct?"), N("Ok"), N("Cancel")); main($w) }
+sub ask_from_entry { my $w = ugtk2->new(shift @_, grab => 1); $w->_ask_from_entry(@_); main($w) }
+sub ask_dir { my $w = ugtk2->new(shift @_, grab => 1); $w->_ask_dir(@_); main($w) }
+
+sub _ask_from_entry($$@) {
+ my ($o, @msgs) = @_;
+ my $entry = gtknew('Entry');
+ my $f = sub { $o->{retval} = $entry->get_text; Gtk2->main_quit };
+ $o->{ok_clicked} = $f;
+ $o->{cancel_clicked} = sub { undef $o->{retval}; Gtk2->main_quit };
+
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@msgs),
+ gtksignal_connect($entry, 'activate' => $f),
+ ($o->{hide_buttons} ? () : create_okcancel($o))),
+ );
+ $entry->grab_focus;
+}
+
+sub _ask_warn($@) {
+ my ($o, @msgs) = @_;
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@msgs),
+ my $w = gtknew('Button', text => N("Ok"), clicked => sub { Gtk2->main_quit }),
+ ),
+ );
+ $w->grab_focus;
+}
+
+sub _ask_okcancel($@) {
+ my ($o, @msgs) = @_;
+ my ($ok, $cancel) = splice @msgs, -2;
+
+ gtkadd($o->{window},
+ gtkpack(create_box_with_title($o, @msgs),
+ create_okcancel($o, $ok, $cancel),
+ )
+ );
+ $o->{ok}->grab_focus;
+}
+
+sub create_file_selector {
+ my (%opts) = @_;
+ my $w = ugtk2->new(delete $opts{title}, modal => 1);
+ my ($message, $save, $want_a_dir) = (delete $opts{message}, delete $opts{save}, delete $opts{want_a_dir});
+ my $action = $want_a_dir ? ($save ? 'create_folder' : 'select_folder') : ($save ? 'save' : 'open');
+ add2hash(\%opts, { width => 480, height => 250 });
+ gtkadd($w->{window},
+ gtkpack_(create_box_with_title($w, $message),
+ 1, $w->{chooser} = gtknew('FileChooser', action => $action, %opts),
+ 0, create_okcancel($w),
+ ));
+ $w->{chooser}->signal_connect(file_activated => sub { $w->{ok}->clicked });
+ $w;
+}
+
+sub file_selected_check {
+ my ($save, $want_a_dir, $file) = @_;
+
+ if (!$file) {
+ N("No file chosen");
+ } elsif (-f $file && $want_a_dir) {
+ N("You have chosen a file, not a directory");
+ } elsif (-d $file && !$want_a_dir) {
+ N("You have chosen a directory, not a file");
+ } elsif (!-e $file && !$save) {
+ $want_a_dir ? N("No such directory") : N("No such file");
+ } else {
+ '';
+ }
+}
+
+sub _ask_file {
+ my ($o, $title, $path) = @_;
+
+ my $w = create_file_selector(title => $title, want_a_dir => 0, directory => $path);
+ put_in_hash($o, $w);
+
+ $w->{ok}->signal_connect(clicked => sub { $o->{retval} = $w->{chooser}->get_filename });
+}
+sub _ask_dir {
+ my ($o, $title, $path) = @_;
+
+ my $w = create_file_selector(title => $title, want_a_dir => 1, directory => $path);
+ put_in_hash($o, $w);
+
+ $w->{ok}->signal_connect(clicked => sub { $o->{retval} = $w->{chooser}->get_filename });
+}
+
+sub ask_browse_tree_info {
+ my ($common) = @_;
+
+ my $w = ugtk2->new($common->{title});
+
+ my $tree_model = Gtk2::TreeStore->new("Glib::String", "Gtk2::Gdk::Pixbuf", "Glib::String");
+ my $tree = Gtk2::TreeView->new_with_model($tree_model);
+ $tree->get_selection->set_mode('browse');
+ $tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
+ $tree->append_column(my $pixcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 1));
+ $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 2));
+ $tree->set_headers_visible(0);
+ $tree->set_rules_hint(1);
+ $textcolumn->set_min_width(200);
+ $textcolumn->set_max_width(200);
+
+ gtkadd($w->{window},
+ gtknew('VBox', spacing => 5, children => [
+ 0, gtknew('Title2', label => $common->{message},
+ # workaround infamous 6 years old gnome bug #101968:
+ width => mygtk2::get_label_width()),
+ 1, gtknew('VBox', children => [
+ 1, gtknew('ScrolledWindow', child => $tree),
+ 0, gtknew('Frame', text => N("Info"), child =>
+ gtknew('ScrolledWindow', child => my $info = gtknew('TextView', editable => 0, height => 100)),
+ ) ]),
+ 0, Gtk2::HSeparator->new,
+ 0, my $status = gtknew('Label'),
+ if_($common->{auto_deps},
+ 0, gtknew('CheckButton', text => $common->{auto_deps}, active_ref => \$common->{state}{auto_deps})
+ ),
+ 0, Gtk2::HSeparator->new,
+ 0, my $box2 = gtknew('HBox', spacing => 10),
+ ]));
+
+ gtkpack__($box2, gtknew(($::isInstall ? 'Install_Button' : 'Button'), text => N("Help"),
+ clicked => $common->{interactive_help})) if $common->{interactive_help};
+
+ #gtkpack__($box2, my $toolbar = Gtk2::Toolbar->new('horizontal', 'icons'));
+ gtkpack__($box2, my $toolbar = Gtk2::Toolbar->new);
+
+ my @l = ([ $common->{ok}, 1 ], if_($common->{cancel}, [ $common->{cancel}, 0 ]));
+ @l = reverse @l if !$::isInstall;
+ my @buttons = map {
+ my ($t, $val) = @$_;
+ $box2->pack_end(my $w = gtknew('Button', text => $t, clicked => sub {
+ $w->{retval} = $val;
+ Gtk2->main_quit;
+ }), 0, 1, 20);
+ $w->show;
+ $w;
+ } @l;
+ @buttons = reverse @buttons if !$::isInstall;
+
+ $status->show;
+
+ $w->{window}->set_size_request(map { $_ - 2 * $border - 4 } $w->{windowwidth}, $w->{windowheight}) if !$::isInstall;
+ $buttons[0]->grab_focus;
+ $w->{rwindow}->show;
+
+ my @toolbar;
+ foreach my $ic (@{$common->{icons} || []}) {
+ push @toolbar, ($ic->{icon} => [ $ic->{help}, sub {
+ if ($ic->{code}) {
+ my $_w = $ic->{wait_message} && $common->{wait_message}->('', $ic->{wait_message});
+ $ic->{code}();
+ $common->{rebuild_tree}->();
+ }
+ } ]);
+ }
+ my %toolbar = @toolbar;
+ foreach (grep_index { $::i % 2 == 0 } @toolbar) {
+ $toolbar->append_item(undef, $toolbar{$_}[0], undef, gtkcreate_img("$_.png"), $toolbar{$_}[1]);
+ }
+
+ $pixcolumn->{is_pix} = 1;
+ $common->{widgets} = { w => $w, tree => $tree, tree_model => $tree_model,
+ info => $info, status => $status };
+ ask_browse_tree_info_given_widgets($common);
+}
+
+sub ask_browse_tree_info_given_widgets {
+ my ($common) = @_;
+ my $w = $common->{widgets};
+
+ my ($curr, $prev_label, $idle, $mouse_toggle_pending);
+ my (%wtree, %ptree, %pix, %node_state, %state_stats);
+ my $update_size = sub {
+ if ($w->{status}) {
+ my $new_label = $common->{get_status}();
+ $prev_label ne $new_label and $w->{status}->set($prev_label = $new_label);
+ }
+ };
+
+ my $set_node_state_flat = sub {
+ my ($iter, $state) = @_;
+ $state eq 'XXX' and return;
+ $pix{$state} ||= gtkcreate_pixbuf($state);
+ $w->{tree_model}->set($iter, 1 => $pix{$state});
+ };
+ my $set_node_state_tree; $set_node_state_tree = sub {
+ my ($iter, $state) = @_;
+ my $iter_str = $w->{tree_model}->get_path_str($iter);
+ $state eq 'XXX' and return;
+ $pix{$state} ||= gtkcreate_pixbuf($state);
+ if ($node_state{$iter_str} ne $state) {
+ my $parent;
+ if (!$w->{tree_model}->iter_has_child($iter) && ($parent = $w->{tree_model}->iter_parent($iter))) {
+ my $parent_str = $w->{tree_model}->get_path_str($parent);
+ my $stats = $state_stats{$parent_str} ||= {}; $stats->{$node_state{$iter_str}}--; $stats->{$state}++;
+ my @list = grep { $stats->{$_} > 0 } keys %$stats;
+ my $new_state = @list == 1 ? $list[0] : 'semiselected';
+ $node_state{$parent_str} ne $new_state and $set_node_state_tree->($parent, $new_state);
+ }
+ $w->{tree_model}->set($iter, 1 => $pix{$state});
+ $node_state{$iter_str} = $state; #- cache for efficiency
+ }
+ };
+ my $set_node_state = $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree;
+
+ my $set_leaf_state = sub {
+ my ($leaf, $state) = @_;
+ $set_node_state->($_, $state) foreach @{$ptree{$leaf}};
+ };
+ my $add_parent; $add_parent = sub {
+ my ($root, $state) = @_;
+ $root or return undef;
+ if (my $w = $wtree{$root}) { return $w }
+ my $s; foreach (split '\|', $root) {
+ my $s2 = $s ? "$s|$_" : $_;
+ $wtree{$s2} ||= do {
+ my $iter = $w->{tree_model}->append_set($s ? $add_parent->($s, $state) : undef, [ 0 => $_ ]);
+ $iter;
+ };
+ $s = $s2;
+ }
+ $set_node_state->($wtree{$s}, $state); #- use this state by default as tree is building.
+ $wtree{$s};
+ };
+ my $add_node = sub {
+ my ($leaf, $root, $options) = @_;
+ my $state = $common->{node_state}($leaf) or return;
+ if ($leaf) {
+ my $iter = $w->{tree_model}->append_set($add_parent->($root, $state), [ 0 => $leaf ]);
+ $set_node_state->($iter, $state);
+ push @{$ptree{$leaf}}, $iter;
+ } else {
+ my $parent = $add_parent->($root, $state);
+ #- hackery for partial displaying of trees, used in rpmdrake:
+ #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree)
+ #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever
+ #- the first child has '' as the label, it will remove the child and add all the "right" children
+ $options->{nochild} or $w->{tree_model}->append_set($parent, [ 0 => '' ]);
+ }
+ };
+ my $clear_all_caches = sub {
+ foreach (values %ptree) {
+ foreach my $n (@$_) {
+ delete $node_state{$w->{tree_model}->get_path_str($n)};
+ }
+ }
+ foreach (values %wtree) {
+ my $iter_str = $w->{tree_model}->get_path_str($_);
+ delete $node_state{$iter_str};
+ delete $state_stats{$iter_str};
+ }
+ %ptree = %wtree = ();
+ };
+ $common->{delete_all} = sub {
+ $clear_all_caches->();
+ $w->{tree_model}->clear;
+ };
+ $common->{rebuild_tree} = sub {
+ $common->{delete_all}->();
+ $set_node_state = $common->{state}{flat} ? $set_node_state_flat : $set_node_state_tree;
+ $common->{build_tree}($add_node, $common->{state}{flat}, $common->{tree_mode});
+ &$update_size;
+ };
+ $common->{delete_category} = sub {
+ my ($cat) = @_;
+ exists $wtree{$cat} or return;
+ foreach (keys %ptree) {
+ my @to_remove;
+ foreach my $node (@{$ptree{$_}}) {
+ my $category;
+ my $parent = $node;
+ my @parents;
+ while ($parent = $w->{tree_model}->iter_parent($parent)) { #- LEAKS
+ my $parent_name = $w->{tree_model}->get($parent, 0);
+ $category = $category ? "$parent_name|$category" : $parent_name;
+ $_->[1] = "$parent_name|$_->[1]" foreach @parents;
+ push @parents, [ $parent, $category ];
+ }
+ if ($category =~ /^\Q$cat/) {
+ push @to_remove, $node;
+ foreach (@parents) {
+ next if $_->[1] eq $cat || !exists $wtree{$_->[1]};
+ delete $wtree{$_->[1]};
+ delete $node_state{$w->{tree_model}->get_path_str($_->[0])};
+ delete $state_stats{$w->{tree_model}->get_path_str($_->[0])};
+ }
+ }
+ }
+ foreach (@to_remove) {
+ delete $node_state{$w->{tree_model}->get_path_str($_)};
+ }
+ @{$ptree{$_}} = difference2($ptree{$_}, \@to_remove);
+ }
+ if (exists $wtree{$cat}) {
+ my $iter_str = $w->{tree_model}->get_path_str($wtree{$cat});
+ delete $node_state{$iter_str};
+ delete $state_stats{$iter_str};
+ $w->{tree_model}->remove($wtree{$cat});
+ delete $wtree{$cat};
+ }
+ &$update_size;
+ };
+ $common->{add_nodes} = sub {
+ my (@nodes) = @_;
+ $add_node->($_->[0], $_->[1], $_->[2]) foreach @nodes;
+ &$update_size;
+ };
+
+ $common->{display_info} = sub { gtktext_insert($w->{info}, $common->{get_info}($curr)); 0 };
+ my $children = sub { map { $w->{tree_model}->get($_, 0) } gtktreeview_children($w->{tree_model}, $_[0]) };
+ my $toggle = sub {
+ if (ref($curr) && !$_[0]) {
+ $w->{tree}->toggle_expansion($w->{tree_model}->get_path($curr));
+ } else {
+ if (ref $curr) {
+ my @l = $common->{grep_allowed_to_toggle}($children->($curr)) or return;
+ my @unsel = $common->{grep_unselected}(@l);
+ my @p = @unsel ?
+ #- not all is selected, select all if no option to potentially override
+ (exists $common->{partialsel_unsel} && $common->{partialsel_unsel}->(\@unsel, \@l) ? difference2(\@l, \@unsel) : @unsel)
+ : @l;
+ $common->{toggle_nodes}($set_leaf_state, @p);
+ &$update_size;
+ } else {
+ $common->{check_interactive_to_toggle}($curr) and $common->{toggle_nodes}($set_leaf_state, $curr);
+ &$update_size;
+ }
+ }
+ };
+
+ $w->{tree}->signal_connect(key_press_event => sub {
+ my $c = chr($_[1]->keyval & 0xff);
+ if ($_[1]->keyval >= 0x100 ? $c eq "\r" || $c eq "\x8d" : $c eq ' ') {
+ $toggle->(0);
+ }
+ 0;
+ });
+
+ $w->{tree}->get_selection->signal_connect(changed => sub {
+ my ($model, $iter) = $_[0]->get_selected;
+ $model && $iter or return;
+ Glib::Source->remove($idle) if $idle;
+
+ if (!$model->iter_has_child($iter)) {
+ $curr = $model->get($iter, 0);
+ $idle = Glib::Timeout->add(100, $common->{display_info});
+ } else {
+ $curr = $iter;
+ }
+ #- the following test for equality is because we can have a button_press_event first, then
+ #- two changed events, the first being on a different row :/ (is it a bug in gtk2?) - that
+ #- happens in rpmdrake when doing a "search" and directly trying to select a found package
+ if ($mouse_toggle_pending eq $model->get($iter, 0)) {
+ $toggle->(1);
+ $mouse_toggle_pending = 0;
+ }
+ 0;
+ });
+ $w->{tree}->signal_connect(button_press_event => sub { #- not too good, but CellRendererPixbuf does not have the needed signals :(
+ my ($path, $column) = $w->{tree}->get_path_at_pos($_[1]->x, $_[1]->y);
+ if ($path && $column) {
+ $column->{is_pix} and $mouse_toggle_pending = $w->{tree_model}->get($w->{tree_model}->get_iter($path), 0);
+ }
+ 0;
+ });
+ $common->{rebuild_tree}->();
+ &$update_size;
+ $common->{initial_selection} and $common->{toggle_nodes}($set_leaf_state, @{$common->{initial_selection}});
+ my $_b = before_leaving { $clear_all_caches->() };
+ $common->{init_callback}->() if $common->{init_callback};
+ $w->{w}->main;
+}
+
+sub gtk_set_treelist {
+ my ($treelist, $l) = @_;
+
+ my $list = $treelist->get_model;
+ $list->clear;
+ $list->append_set([ 0 => $_ ]) foreach @$l;
+}
+
+
+sub gtk_TextView_get_log {
+ my ($log_w, $command, $filter_output, $when_command_is_over) = @_;
+
+ my $pid = open(my $F, "$command |") or return;
+ common::nonblock($F);
+
+ my $gtk_buffer = $log_w->get_buffer;
+ $log_w->signal_connect(destroy => sub {
+ kill 9, $pid if $pid; #- we do not continue in background
+ $pid = $gtk_buffer = ''; #- ensure $gtk_buffer is valid when its value is non-null
+ });
+
+ Glib::Timeout->add(100, sub {
+ if ($gtk_buffer) {
+ my $end = $gtk_buffer->get_end_iter;
+ while (defined (my $s = <$F>)) {
+ $gtk_buffer->insert($end, $filter_output->($s));
+ }
+ $log_w->{to_bottom}->();
+ }
+ if (waitpid($pid, c::WNOHANG()) > 0) {
+ #- we do not call $when_command_is_over if $gtk_buffer does not exist anymore
+ #- since it is not a normal case
+ $when_command_is_over->($gtk_buffer) if $when_command_is_over && $gtk_buffer;
+ $pid = '';
+ 0;
+ } else {
+ to_bool($gtk_buffer);
+ }
+ });
+ $pid; #- $pid becomes invalid after $when_command_is_over is called
+}
+
+sub gtk_new_TextView_get_log {
+ my ($command, $filter_output, $when_command_is_over) = @_;
+
+ my $log_w = gtknew('TextView', editable => 0);
+ my $log_scroll = gtknew('ScrolledWindow', child => $log_w, to_bottom => 1);
+ my $pid = gtk_TextView_get_log($log_w, $command, $filter_output, $when_command_is_over) or return;
+ $log_scroll, $pid;
+}
+
+# misc helpers:
+
+package Gtk2::TreeStore;
+sub append_set {
+ my ($model, $parent, @values) = @_;
+ # compatibility:
+ @values = @{$values[0]} if @values == 1 && ref($values[0]) eq 'ARRAY';
+ my $iter = $model->append($parent);
+ $model->set($iter, @values);
+ return $iter;
+}
+
+
+package Gtk2::ListStore;
+# Append a new row, set the values, return the TreeIter
+sub append_set {
+ my ($model, @values) = @_;
+ # compatibility:
+ @values = @{$values[0]} if @values == 1 && ref($values[0]) eq 'ARRAY';
+ my $iter = $model->append;
+ $model->set($iter, @values);
+ return $iter;
+}
+
+
+package Gtk2::TreeModel;
+# gets the string representation of a TreeIter
+sub get_path_str {
+ my ($self, $iter) = @_;
+ my $path = $self->get_path($iter);
+ $path or return;
+ $path->to_string;
+}
+
+sub iter_each_children {
+ my ($model, $iter, $f) = @_;
+ for (my $child = $model->iter_children($iter); $child; $child = $model->iter_next($child)) {
+ $f->($child);
+ }
+}
+
+package Gtk2::TreeView;
+# likewise gtk-1.2 function
+sub toggle_expansion {
+ my ($self, $path, $b_open_all) = @_;
+ if ($self->row_expanded($path)) {
+ $self->collapse_row($path);
+ } else {
+ $self->expand_row($path, $b_open_all || 0);
+ }
+}
+
+
+# With GTK+, for more GUIes coherency, GtkOptionMenu is recommended instead of a
+# combo if the user is selecting from a fixed set of options.
+#
+# That is, non-editable combo boxes are not encouraged. GtkOptionMenu is much
+# easier to use than GtkCombo as well. Use GtkCombo only when you need the
+# editable text entry.
+#
+# GtkOptionMenu is a much better-implemented widget and also the right UI for
+# noneditable sets of choices.)
+#
+# GtkCombo is deprecated in 2.4.x because it still uses deprecated
+# GtkList. GtkOption menu is deprecated in order to have an unified widget.
+#
+# GtkComBox widget replaces GtkOption menu whereas GtkComBoxEntry replaces GtkCombo.
+#
+#
+# This layer try to make OptionMenu and ComboBox look being api
+# compatible with Combo since its API is quite nice.
+
+package Gtk2::OptionMenu;
+use MDK::Common;
+
+# try to get combox <==> option menu mapping
+sub set_popdown_strings {
+ my ($w, @strs) = @_;
+ my $menu = Gtk2::Menu->new;
+ # keep string list around for ->set_text compatibilty helper
+ $w->{strings} = \@strs;
+ #$w->set_menu((ugtk2::create_factory_menu($window, [ "File", (undef) x 3, '<Branch>' ], map { [ "File/" . $_, (undef) x 3, '<Item>' ] } @strs))[0]);
+ $menu->append(ugtk2::gtkshow(Gtk2::MenuItem->new_with_label($_))) foreach @strs;
+ $w->set_menu($menu);
+ $w;
+}
+
+sub new_with_strings {
+ my ($class, $strs, $o_val) = @_;
+ my $w = $class->new;
+ $w->set_popdown_strings(@$strs);
+ $w->set_text($o_val) if $o_val;
+ $w;
+}
+
+sub entry {
+ my ($w) = @_;
+ return $w;
+}
+
+sub get_text {
+ my ($w) = @_;
+ $w->get_history == -1 ? '' : $w->{strings}[$w->get_history];
+}
+
+sub set_text {
+ my ($w, $val) = @_;
+ each_index {
+ if ($_ eq $val) {
+ $w->set_history($::i);
+ return;
+ }
+ } @{$w->{strings}};
+}
+
+
+
+
+package Gtk2::ComboBox;
+use MDK::Common;
+
+# try to get combox <==> option menu mapping
+sub set_popdown_strings {
+ my ($w, @strs) = @_;
+ $w->get_model->clear;
+ # keep string list around for ->set_text compatibilty helper
+ $w->{strings} = \@strs;
+ $w->append_text($_) foreach @strs;
+ $w;
+}
+
+sub new_with_strings {
+ my ($class, $strs, $o_val) = @_;
+ my $w = $class->new_text;
+ $w->set_popdown_strings(@$strs);
+ $w->set_text($o_val) if $o_val;
+ $w;
+}
+
+sub entry {
+ my ($w) = @_;
+ return $w;
+}
+
+sub get_text {
+ my ($w) = @_;
+ $w->get_active == -1 ? '' : $w->{strings}[$w->get_active];
+}
+
+sub set_text {
+ my ($w, $val) = @_;
+ eval {
+ my $val_index = find_index { $_ eq $val } @{$w->{strings}};
+ $w->set_active($val_index);
+ };
+ # internal_error(qq(impossible to lookup "$val":\n\t) . chomp_($@)) if $@;
+}
+
+
+package Gtk2::Label;
+sub set {
+ my ($label, $text) = @_;
+ mygtk2::gtkset($label, text => $text);
+}
+
+
+package Gtk2::WrappedLabel;
+sub new {
+ my ($_type, $o_text, $o_align) = @_;
+ mygtk2::gtknew('WrappedLabel', text => $o_text || '', alignment => [ $o_align || 0, 0.5 ]);
+}
+
+
+package Gtk2::Entry;
+sub new_with_text {
+ my ($_class, $o_text) = @_;
+ mygtk2::gtknew('Entry', text => $o_text);
+}
+
+
+package Gtk2::Banner;
+
+use MDK::Common;
+use mygtk2 qw(gtknew);
+use ugtk2 qw(:helpers :wrappers);
+
+sub set_pixmap {
+ my ($darea) = @_;
+ return if !$darea->realized;
+ ugtk2::set_back_pixbuf($darea, $darea->{back_pixbuf});
+ update_text($darea);
+}
+
+sub update_text {
+ my ($darea) = @_;
+ $darea->{layout} = $darea->create_pango_layout($darea->{text});
+ $darea->{txt_width} = first($darea->{layout}->get_pixel_size);
+ $darea->queue_draw;
+}
+
+
+sub new {
+ my ($_class, $icon, $text, $o_options) = @_;
+
+ mygtk2::import_style_ressources();
+ my $darea = gtknew('DrawingArea', widget_name => 'Banner');
+ $darea->{back_pixbuf} = gtknew('Pixbuf', file => 'banner-background');
+ my $d_height = $darea->{back_pixbuf}->get_height;
+ $darea->set_size_request(-1, $d_height);
+ $darea->modify_font(Gtk2::Pango::FontDescription->from_string("13"));
+ eval { $darea->{icon} = ugtk2::gtkcreate_pixbuf($icon) };
+ $darea->{icon} ||= ugtk2::gtkcreate_pixbuf(ugtk2::wm_icon());
+ my $blue_part = eval { gtknew('Pixbuf', file => 'banner-blue-part', flip => mygtk2::text_direction_rtl()) };
+ my $blue_width = $blue_part->get_width;
+ $darea->{text} = $text;
+ require lang;
+ my $is_rtl = lang::text_direction_rtl();
+
+ $darea->signal_connect(realize => \&set_pixmap);
+ $darea->signal_connect("style-set" => \&set_pixmap);
+ $darea->signal_connect(expose_event => sub {
+ my $style = $darea->get_style;
+ my $height = $darea->{icon}->get_height;
+ my $width = $darea->{icon}->get_width;
+ # fix icon position when not using the default height:
+ (undef, undef, undef, $d_height) = $darea->window->get_geometry;
+ my $padding = int(($d_height - $height)/2);
+ my $d_width = $darea->allocation->width;
+ my $x_blue = $is_rtl ? $d_width - $blue_width : 0;
+ my $x_icon = $is_rtl ? $d_width - 12 - $width : 12;
+ # here: 48 is the amount of white background in the blue background we wish to ignore:
+ my $x_text = $is_rtl ? $d_width - $blue_width + 48 - $darea->{txt_width} : $blue_width - 48;
+ $darea->{layout_height} ||= second($darea->{layout}->get_pixel_size);
+ $blue_part->render_to_drawable($darea->window, $style->bg_gc('normal'),
+ 0, 0, $x_blue, 0, -1, -1, 'none', 0, 0);
+ $darea->{icon}->render_to_drawable($darea->window, $style->bg_gc('normal'),
+ 0, 0, $x_icon, $padding, -1, -1, 'none', 0, 0);
+ $darea->window->draw_layout($style->fg_gc('normal'), $x_text,
+ $o_options->{txt_ypos} || ($d_height - $darea->{layout_height})/2,
+ $darea->{layout});
+ 1;
+ });
+
+ return $darea;
+}
+
+
+package Gtk2::MDV::CellRendererPixWithLabel;
+
+use MDK::Common;
+use Glib::Object::Subclass "Gtk2::CellRenderer",
+ properties => [
+ Glib::ParamSpec->string("label", "Label", "A meaningfull label", "", [qw(readable writable)]),
+ Glib::ParamSpec->object("pixbuf", "Pixbuf file", "Something nice to display", 'Gtk2::Gdk::Pixbuf', [qw(readable writable)]),
+ ];
+
+my $x_padding = 2;
+my $y_padding = 2;
+
+sub INIT_INSTANCE {}
+
+sub pixbuf_size {
+ my ($cell) = @_;
+ my $pixbuf = $cell->get('pixbuf');
+ $pixbuf ? ($pixbuf->get_width, $pixbuf->get_height) : (0, 0);
+}
+
+sub calc_size {
+ my ($cell, $layout) = @_;
+ my ($width, $height) = $layout->get_pixel_size;
+ my ($pwidth, $pheight) = pixbuf_size($cell);
+
+ return 0, 0,
+ $width + $x_padding * 3 + $pwidth,
+ max($pheight, $height + $y_padding * 2);
+}
+
+sub GET_SIZE {
+ my ($cell, $widget, $_cell_area) = @_;
+
+ my $layout = get_layout($cell, $widget);
+ $layout->set_text($cell->get('label'));
+
+ return calc_size($cell, $layout);
+}
+
+sub get_layout {
+ my ($_cell, $widget) = @_;
+ return $widget->create_pango_layout("");
+}
+
+sub RENDER { # not that efficient...
+ my ($cell, $window, $widget, $_background_area, $cell_area, $_expose_area, $flags) = @_;
+ my $state;
+ if ($flags & 'selected') {
+ $state = $widget->has_focus
+ ? 'selected'
+ : 'active';
+ } else {
+ $state = $widget->state eq 'insensitive'
+ ? 'insensitive'
+ : 'normal';
+ }
+
+ my $layout = get_layout($cell, $widget);
+ $layout->set_text($cell->get('label'));
+
+ my $is_rtl = lang::text_direction_rtl();
+ my $txt_width = first($layout->get_pixel_size);
+
+ my ($x_offset, $y_offset, $_width, $_height) = calc_size($cell, $layout);
+ my $pixbuf = $cell->get('pixbuf');
+ my ($pwidth, $pheight) = pixbuf_size($cell);
+ my $txt_offset = $cell_area->x + $x_offset + $x_padding * 2 + $pwidth;
+
+ if ($pixbuf) {
+ $pixbuf->render_to_drawable($window, $widget->style->fg_gc('normal'),
+ 0, 0,
+ $is_rtl ? $cell_area->width - $cell_area->x - $pwidth : $cell_area->x ,#+ $x_padding,
+ $cell_area->y, #+ $y_padding,
+ $pwidth, $pheight, 'none', 0, 0);
+ }
+ $widget->get_style->paint_layout($window,
+ $state,
+ 1,
+ $cell_area,
+ $widget,
+ "cellrenderertext",
+ $is_rtl ? $cell_area->width - $txt_width - $txt_offset : $txt_offset,
+ $cell_area->y + $y_offset + $y_padding,
+ $layout);
+
+}
+
+1;
+
+
+package Gtk2::Notify::Queue;
+
+sub new {
+ my ($class, $statusicon) = @_;
+
+ require Gtk2::Notify;
+
+ my $self = bless {
+ queue => [],
+ statusicon => $statusicon,
+ display => 5000,
+ delay => 500,
+ }, $class;
+ $self;
+}
+
+sub process_next {
+ my ($self) = @_;
+ shift @{$self->{queue}};
+ #- wait for some time so that the new notification is noticeable
+ @{$self->{queue}} and Glib::Timeout->add($self->{delay}, sub { $self->show; 0 });
+}
+
+sub add {
+ my ($self, $info) = @_;
+ push @{$self->{queue}}, $info;
+ @{$self->{queue}} == 1 and $self->show;
+}
+
+sub show {
+ my ($self) = @_; # perl_checker: $self = Gtk2::Notify->new
+ my $info = $self->{queue}[0];
+ my $notification = Gtk2::Notify->new($info->{title}, $info->{message}, $self->{statusicon});
+ $notification->set_icon_from_pixbuf($info->{pixbuf}) if $info->{pixbuf};
+ $notification->set_urgency($info->{urgency}) if $info->{urgency};
+ foreach my $a (@{$info->{actions} || []}) {
+ $notification->add_action(
+ $a->{action}, $a->{label},
+ sub {
+ $info->{processed} = 1;
+ #- $a->{callback} has to call $selft->process_next when done
+ $a->{callback}->();
+ });
+ }
+ $notification->signal_connect(closed => sub {
+ $info->{processed} and return;
+ $info->{timeout}->() if $info->{timeout};
+ $self->process_next;
+ });
+ # this makes net_applet to segfault (mga#9102):
+ #eval { $notification->show };
+}
+
+1;
+
+
+package Gtk2::GUI_Update_Guard;
+
+use MDK::Common::Func qw(before_leaving);
+use ugtk2;
+
+sub new {
+ my ($_class) = @_; # prevent a perl_checker warning in callers
+ my $old_signal = $SIG{ALRM};
+ $SIG{ALRM} = sub {
+ ugtk2::gtkflush();
+ alarm(1);
+ };
+ alarm(1);
+ return before_leaving {
+ alarm(0);
+ $SIG{ALRM} = $old_signal || 'DEFAULT'; # restore default action
+ };
+}
+
+1;