From e077d9de9c53e01dab6243941fc2ece05998f6ad Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Wed, 1 Aug 2012 17:12:50 +0200 Subject: rename for gtk+3 --- perl-install/mygtk2.pm | 1598 ---------------------------------------------- perl-install/mygtk3.pm | 1598 ++++++++++++++++++++++++++++++++++++++++++++++ perl-install/ugtk2.pm | 1652 ------------------------------------------------ perl-install/ugtk3.pm | 1652 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 3250 insertions(+), 3250 deletions(-) delete mode 100644 perl-install/mygtk2.pm create mode 100644 perl-install/mygtk3.pm delete mode 100644 perl-install/ugtk2.pm create mode 100644 perl-install/ugtk3.pm (limited to 'perl-install') diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm deleted file mode 100644 index 779e77e8f..000000000 --- a/perl-install/mygtk2.pm +++ /dev/null @@ -1,1598 +0,0 @@ -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($label); - } else { - qq($label); - } -} - -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/mygtk3.pm b/perl-install/mygtk3.pm new file mode 100644 index 000000000..779e77e8f --- /dev/null +++ b/perl-install/mygtk3.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($label); + } else { + qq($label); + } +} + +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 deleted file mode 100644 index 3db9ff814..000000000 --- a/perl-install/ugtk2.pm +++ /dev/null @@ -1,1652 +0,0 @@ -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/'/'/) 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 = ('&' => '&', - '<' => '<', - '>' => '>', - ); - 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", '
', @_) } -sub create_factory_menu { create_factory_menu_("Gtk2::MenuBar", '
', @_) } - -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, '' ], map { [ "File/" . $_, (undef) x 3, '' ] } @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; diff --git a/perl-install/ugtk3.pm b/perl-install/ugtk3.pm new file mode 100644 index 000000000..3db9ff814 --- /dev/null +++ b/perl-install/ugtk3.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/'/'/) 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 = ('&' => '&', + '<' => '<', + '>' => '>', + ); + 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", '
', @_) } +sub create_factory_menu { create_factory_menu_("Gtk2::MenuBar", '
', @_) } + +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, '' ], map { [ "File/" . $_, (undef) x 3, '' ] } @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; -- cgit v1.2.1