summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-01-06 16:20:52 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-01-06 16:20:52 +0000
commit2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1 (patch)
tree1a4b617866229fab81835f368ad6e9863461b3fc /perl-install
parent36772d0e48af0e3fd74f3255f842a5b98f90f55b (diff)
downloaddrakx-2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1.tar
drakx-2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1.tar.gz
drakx-2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1.tar.bz2
drakx-2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1.tar.xz
drakx-2e45ccff1d73c392c7c6480b3c5d6ffdd9f0a5c1.zip
- move some install specific code out of ugtk2.pm into install_gtk.pm
- move some install specific code out of common.pm into install_any.pm
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/common.pm27
-rw-r--r--perl-install/install2.pm2
-rw-r--r--perl-install/install_any.pm28
-rw-r--r--perl-install/install_gtk.pm25
-rw-r--r--perl-install/ugtk2.pm24
5 files changed, 59 insertions, 47 deletions
diff --git a/perl-install/common.pm b/perl-install/common.pm
index fb1239d66..f6ff2b64e 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -175,33 +175,6 @@ sub group_n_lm {
@l;
}
-sub screenshot_dir__and_move() {
- my ($dir1, $dir2) = ("$::prefix/root", '/tmp/stage2');
- if (-e $dir1) {
- if (-e "$dir2/DrakX-screenshots") {
- cp_af("$dir2/DrakX-screenshots", $dir1);
- rm_rf("$dir2/DrakX-screenshots");
- }
- $dir1;
- } else {
- $dir2;
- }
-}
-
-sub take_screenshot() {
- my $dir = screenshot_dir__and_move() . '/DrakX-screenshots';
- my $warn;
- if (!-e $dir) {
- mkdir $dir or $::o->ask_warn('', N("Can not make screenshots before partitioning")), return;
- $warn = 1;
- }
- my $nb = 1;
- $nb++ while -e "$dir/$nb.png";
- system("fb2png /dev/fb0 $dir/$nb.png 0");
-
- $::o->ask_warn('', N("Screenshots will be available after install in %s", "/root/DrakX-screenshots")) if $warn;
-}
-
sub join_lines {
my @l;
my $s;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index b8f5ffe2d..d8c0e7f25 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -189,7 +189,7 @@ sub formatPartitions {
eval { fs::mount('none', "$o->{prefix}/proc/bus/usb", 'usbdevfs') };
eval { fs::mount('none', "$o->{prefix}/sys", 'sysfs') };
- common::screenshot_dir__and_move();
+ install_any::screenshot_dir__and_move();
install_any::move_clp_to_disk();
any::rotate_logs($o->{prefix});
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index c995836e0..3042f34f8 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -1500,6 +1500,34 @@ sub X_options_from_o {
};
}
+sub screenshot_dir__and_move() {
+ my ($dir1, $dir2) = ("$::prefix/root", '/tmp/stage2');
+ if (-e $dir1) {
+ if (-e "$dir2/DrakX-screenshots") {
+ cp_af("$dir2/DrakX-screenshots", $dir1);
+ rm_rf("$dir2/DrakX-screenshots");
+ }
+ $dir1;
+ } else {
+ $dir2;
+ }
+}
+
+sub take_screenshot {
+ my ($in) = @_;
+ my $dir = screenshot_dir__and_move() . '/DrakX-screenshots';
+ my $warn;
+ if (!-e $dir) {
+ mkdir $dir or $in->ask_warn('', N("Can not make screenshots before partitioning")), return;
+ $warn = 1;
+ }
+ my $nb = 1;
+ $nb++ while -e "$dir/$nb.png";
+ system("fb2png /dev/fb0 $dir/$nb.png 0");
+
+ $in->ask_warn('', N("Screenshots will be available after install in %s", "/root/DrakX-screenshots")) if $warn;
+}
+
sub copy_advertising {
my ($o) = @_;
diff --git a/perl-install/install_gtk.pm b/perl-install/install_gtk.pm
index b95063f92..d5d602f93 100644
--- a/perl-install/install_gtk.pm
+++ b/perl-install/install_gtk.pm
@@ -240,6 +240,31 @@ sub init_sizes() {
$::move and $::windowwidth -= 100;
}
+sub handle_unsafe_mouse {
+ my ($o, $window) = @_;
+
+ $o->{mouse}{unsafe} or return;
+
+ $window->add_events('pointer-motion-mask');
+ my $signal; $signal = $window->signal_connect(motion_notify_event => sub {
+ delete $o->{mouse}{unsafe};
+ log::l("unsetting unsafe mouse");
+ $window->signal_handler_disconnect($signal);
+ });
+}
+
+sub special_shortcuts {
+ my (undef, $event) = @_;
+ my $d = ${{ $Gtk2::Gdk::Keysyms{F2} => 'screenshot', $Gtk2::Gdk::Keysyms{Delete} => 'restart' }}{$event->keyval};
+ if ($d eq 'screenshot') {
+ take_screenshot($::o);
+ } elsif ($d eq 'restart' && member('control-mask', @{$event->state}) && member('mod1-mask', @{$event->state})) {
+ log::l("restarting install");
+ ugtk2->exit(0x35);
+ }
+ 0;
+}
+
#------------------------------------------------------------------------------
sub createXconf {
my ($file, $mouse_type, $mouse_dev, $_wacom_dev, $Driver) = @_;
diff --git a/perl-install/ugtk2.pm b/perl-install/ugtk2.pm
index 28114565f..06c5a0594 100644
--- a/perl-install/ugtk2.pm
+++ b/perl-install/ugtk2.pm
@@ -872,17 +872,8 @@ sub new {
gtkadd($::WizardWindow, gtknew('Frame', shadow_type => 'out', child => $::WizardTable));
if ($::isInstall) {
- $::WizardWindow->signal_connect(key_press_event => sub {
- my (undef, $event) = @_;
- my $d = ${{ $Gtk2::Gdk::Keysyms{F2} => 'screenshot', $Gtk2::Gdk::Keysyms{Delete} => 'restart' }}{$event->keyval};
- if ($d eq 'screenshot') {
- common::take_screenshot();
- } elsif ($d eq 'restart' && member('control-mask', @{$event->state}) && member('mod1-mask', @{$event->state})) {
- log::l("restarting install");
- $o->exit(0x35);
- }
- 0;
- });
+ require install_gtk; #- for perl_checker
+ $::WizardWindow->signal_connect(key_press_event => \&install_gtk::special_shortcuts);
} elsif (!$o->{isEmbedded}) {
$::WizardWindow->set_position('center_always') if !$::isStandalone;
eval { gtkpack__($::WizardTable, Gtk2::Banner->new(wm_icon(), $::Wizard_title)) };
@@ -971,14 +962,9 @@ sub _create_window {
}
});
- if ($::isInstall && $::o->{mouse}{unsafe}) {
- $w->add_events('pointer-motion-mask');
- my $signal; #- do not make this line part of next one, signal_disconnect will not be able to access $signal value
- $signal = $w->signal_connect(motion_notify_event => sub {
- delete $::o->{mouse}{unsafe};
- log::l("unsetting unsafe mouse");
- $w->signal_handler_disconnect($signal);
- });
+ if ($::isInstall) {
+ require install_gtk; #- for perl_checker
+ install_gtk::handle_unsafe_mouse($::o, $w);
}
if ($force_center_at_pos) {