summaryrefslogtreecommitdiffstats
path: root/perl-install/mygtk2.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-01-11 11:52:50 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-01-11 11:52:50 +0000
commitecde5ab343987a8d0e92b225269ab9f0527e7e15 (patch)
tree5a277e9960b79af47ac83d886d015c4aa782dfe4 /perl-install/mygtk2.pm
parentee6ad956214f83f189b5e32687efa0859cd61efe (diff)
downloaddrakx-backup-do-not-use-ecde5ab343987a8d0e92b225269ab9f0527e7e15.tar
drakx-backup-do-not-use-ecde5ab343987a8d0e92b225269ab9f0527e7e15.tar.gz
drakx-backup-do-not-use-ecde5ab343987a8d0e92b225269ab9f0527e7e15.tar.bz2
drakx-backup-do-not-use-ecde5ab343987a8d0e92b225269ab9f0527e7e15.tar.xz
drakx-backup-do-not-use-ecde5ab343987a8d0e92b225269ab9f0527e7e15.zip
move ugtk2::create_window() to mygtk2::_create_Window()
Diffstat (limited to 'perl-install/mygtk2.pm')
-rw-r--r--perl-install/mygtk2.pm74
1 files changed, 74 insertions, 0 deletions
diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm
index 1e6dbfa87..0bc5a37e1 100644
--- a/perl-install/mygtk2.pm
+++ b/perl-install/mygtk2.pm
@@ -554,6 +554,80 @@ sub _gtknew_handle_children {
}
}
+sub _create_Window {
+ my (%options) = @_;
+
+ my $no_Window_Manager = !$::isStandalone;
+
+ my $w = gtknew('Window',
+ if_(!$::isInstall && !$::isWizard, border_width => 5),
+
+ #- policy: during install, we need a special code to handle the weird centering, see below
+ position_policy => $::isInstall ? 'none' : $no_Window_Manager ? 'center-always' : 'center-on-parent',
+
+ if_($::isInstall, position => [
+ $::rootwidth - ($::windowwidth + $::real_windowwidth) / 2,
+ $::logoheight + ($::windowheight - $::real_windowheight) / 2,
+ ]),
+ %options);
+
+ #- when the window is closed using the window manager "X" button (or alt-f4)
+ $w->signal_connect(delete_event => sub {
+ if ($::isWizard) {
+ $w->destroy;
+ die 'wizcancel';
+ } else {
+ Gtk2->main_quit;
+ }
+ });
+
+ if ($no_Window_Manager) {
+ _force_keyboard_focus($w);
+ }
+
+ if ($::isInstall) {
+ 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-on-parent is a window manager hint, and we don't have a WM
+ my ($wi, $he);
+ $w->signal_connect(size_allocate => sub {
+ my (undef, $event) = @_;
+ my @w_size = $event->values;
+ return if $w_size[2] == $wi && $w_size[3] == $he; #BUG
+ (undef, undef, $wi, $he) = @w_size;
+
+ $w->set_uposition(max(0, $::rootwidth - ($::windowwidth + $wi) / 2),
+ max(0, $::logoheight + ($::windowheight - $he) / 2));
+ });
+ }
+
+ $w;
+}
+
+my $current_window;
+sub _force_keyboard_focus {
+ my ($w) = @_;
+
+ sub _XSetInputFocus {
+ my ($w) = @_;
+ if ($current_window == $w) {
+ $w->window->XSetInputFocus;
+ } else {
+ log::l("not XSetInputFocus since already done and not on top");
+ }
+ 0;
+ }
+
+ #- force keyboard focus instead of mouse focus
+ my $previous_current_window = $current_window;
+ $current_window = $w;
+ $w->signal_connect(expose_event => \&_XSetInputFocus);
+ $w->signal_connect(destroy => sub { $current_window = $previous_current_window });
+}
+
sub _find_imgfile {
my ($name) = @_;