summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile12
-rw-r--r--docs/README9
-rw-r--r--docs/TODO10
-rw-r--r--docs/object_class.fig2
-rw-r--r--perl-install/Makefile60
-rw-r--r--perl-install/Xconfigurator.pm8
-rw-r--r--perl-install/c/stuff.pm3
-rw-r--r--perl-install/common.pm8
-rw-r--r--perl-install/help.pm26
-rw-r--r--perl-install/install2.pm34
-rw-r--r--perl-install/install_any.pm4
-rw-r--r--perl-install/install_steps.pm30
-rw-r--r--perl-install/install_steps_gtk.pm811
-rw-r--r--perl-install/install_steps_interactive.pm62
-rw-r--r--perl-install/install_steps_newt.pm34
-rw-r--r--perl-install/install_steps_stdio.pm56
-rw-r--r--perl-install/interactive.pm24
-rw-r--r--perl-install/interactive_gtk.pm17
-rw-r--r--perl-install/interactive_newt.pm350
-rw-r--r--perl-install/interactive_stdio.pm20
-rw-r--r--perl-install/partition_table_raw.pm1
-rw-r--r--perl-install/pkgs.pm2
-rw-r--r--perl-install/share/compssList1
23 files changed, 1221 insertions, 363 deletions
diff --git a/Makefile b/Makefile
index fda9e0ac1..ed39e588c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,13 +1,15 @@
BOOT_IMG = gi_hd.img gi_cdrom.img gi_network.img gi_network_ks.img gi_pcmcia.img gi_pcmcia_ks.img
BINS = install/install install/local-install install/installinit/init
DIRS = install install/installinit mouseconfig perl-install ddcprobe lnx4win
+ROOTDEST = /export
.PHONY: dirs $(FLOPPY_IMG)
install: build
- mkdir -p /export/images 2>/dev/null ||:
- cp -f $(BOOT_IMG) /export/images
+ for i in images misc Mandrake Mandrake/base; do install -d $(ROOTDEST)/$$i ; done
+ cp -f $(BOOT_IMG) $(ROOTDEST)/images
+ install make_mdkinst_stage2 $(ROOTDEST)/misc
make -C perl-install full_stage2
build: dirs $(BOOT_IMG)
@@ -38,12 +40,12 @@ clean:
upload: tar install
touch /tmp/mdkinst_done
rm ~/gi/*_ks.img
- cd /export/Mandrake ; tar cfz mdkinst.tgz mdkinst
+ cd $(ROOTDEST)/Mandrake ; tar cfz mdkinst.tgz mdkinst
# lftp -c "open -u devel mandrakesoft.com; cd ~/cooker/cooker/images ; mput ~/gi/gi_*.img ;"
- lftp -c "open -u devel mandrakesoft.com; cd ~/tmp ; put /export/Mandrake/mdkinst.tgz ; put /tmp/mdkinst_done ; cd ~/cooker/cooker/Mandrake/base ; put /export/Mandrake/base/mdkinst_stage2.gz ; put ~/gi/perl-install/compss ; put ~/gi/perl-install/compssList ; put ~/gi/perl-install/compssUsers "
+ lftp -c "open -u devel mandrakesoft.com; cd ~/tmp ; put $(ROOTDEST)/Mandrake/mdkinst.tgz ; put /tmp/mdkinst_done ; cd ~/cooker/cooker/Mandrake/base ; put $(ROOTDEST)/Mandrake/base/mdkinst_stage2.gz ; put ~/gi/perl-install/compss ; put ~/gi/perl-install/compssList ; put ~/gi/perl-install/compssUsers ; cd ~/cooker/cooker/misc ; put ~/gi/make_mdkinst_stage2 "
# lftp -c "open -u devel mandrakesoft.com; cd ~/cooker/contrib/others/src ; put ~/gi.tar.bz2"
- rm -f /export/Mandrake/mdkinst.tgz
+ rm -f $(ROOTDEST)/Mandrake/mdkinst.tgz
rm -f /tmp/mdkinst_done
# mkisofs -R -b images/gi_cdrom.img -c images/.catalog /tmp/r /mnt/disk/ | cdrecord -v -eject speed=6 dev=1,0 -
diff --git a/docs/README b/docs/README
index e04ea5829..1846cb03a 100644
--- a/docs/README
+++ b/docs/README
@@ -29,7 +29,8 @@ just have to update:
- Mandrake/base/hdlist: use ``misc/genhdlist .''
- Mandrake/base/depslist: use ``misc/gendepslist -h Mandrake/base/depslist Mandrake/base/hdlist''
-Optionnally, you can modify Mandrake/base/compss, compssList and compssUsers
+Optionnally, you can modify Mandrake/base/compss, compssList and compssUsers.
+Also, mdkinst_stage2.gz must be remade if you modify files in Mandrake/mdkinst.
See below for information about these files.
********************************************************************************
@@ -64,9 +65,9 @@ Mandrake/mdkinst
more.
Mandrake/base/mdkinst_stage2.gz
- for the ramdisk.
- live sytem in ext2 filesystem gzipped. See ``Ramdisk or not'' below for
- more.
+ for the ramdisk. live sytem in ext2 filesystem gzipped.
+ generated from Mandrake/mdkinst tree using misc/make_mdkinst_stage2
+ See ``Ramdisk or not'' below for more.
images/gi_*.img
boot images to use with panoramix. Use:
diff --git a/docs/TODO b/docs/TODO
index b3604ba85..5eabaf5b9 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -10,9 +10,7 @@ X configuration and bootloader in kickstart
(pix)diskdrake
auto_partitions
-text install
-
-(pix)options in mkfs
+(pix)options in mkfs, progress bar when formatting
(pix)Tree -> CTree, ``all'' branch with all packages
@@ -85,6 +83,7 @@ diskdrake should warn if nb_ide_parts > 63, nb_scsi_parts > 15
(?)strange: no scsi of type 'fd', only 'tape'
+compress hdlist?
(done,pix)kudzu or not in miscellaneous
@@ -97,3 +96,8 @@ diskdrake should warn if nb_ide_parts > 63, nb_scsi_parts > 15
(done,fpons)modem config
(done,pix)call kudzu in batch to initialize its list
+
+(done,pix)standalone generator of mdkinst_stage2.gz
+
+(done,pix)text install
+
diff --git a/docs/object_class.fig b/docs/object_class.fig
index 0c9ffaff5..44fd3fe89 100644
--- a/docs/object_class.fig
+++ b/docs/object_class.fig
@@ -23,7 +23,7 @@ Single
2625 1200 4950 1725
2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
7575 1125 4950 1725
-4 0 0 100 0 0 12 0.0000 4 180 1755 1800 1050 install_steps_graphical\001
+4 0 0 100 0 0 12 0.0000 4 180 1755 1800 1050 install_steps_gtk\001
4 0 0 100 0 0 12 0.0000 4 180 1440 6900 975 install_steps_stdio\001
4 0 0 100 0 0 12 0.0000 4 180 1140 2100 1950 interactive_gtk\001
4 0 0 100 0 0 12 0.0000 4 180 1275 6900 1950 interactive_stdio\001
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 554a82a82..056f977de 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,30 +1,28 @@
VERSION = 2.2.10-BOOT
SUDO = sudo
-MKE2FS = /sbin/mke2fs -q -m 0 -F -s 1
SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake g_auto_install
+PMS = *.pm Newt/*.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake g_auto_install
REP4PMS = /usr/bin/perl-install
ROOTDEST = /export
DEST = $(ROOTDEST)/Mandrake/mdkinst
STAGE2 = $(ROOTDEST)/Mandrake/base/mdkinst_stage2
BASE = $(ROOTDEST)/Mandrake/base
DESTREP4PMS = $(DEST)$(REP4PMS)
-STAGE2TMP = /tmp/stage2_tmp
PERL = perl
LOCALFILES = pnp_serial mouseconfig ddcxinfos
LOCALFILES2 = extract_archive
-DIRS = c po pci_probing resize_fat
+DIRS = c Newt po pci_probing resize_fat
EXCLUDE = $(LOCALFILES) boot.img keymaps consolefonts install
RPMS = $(wildcard $(ROOTDEST)/Mandrake/RPMS/*.rpm)
CFLAGS = -Wall
override CFLAGS += -pipe
-.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
+.PHONY: all $(DIRS) install clean stage2 full_stage2 verify_c
-all: $(DIRS)
+all: TAGS $(DIRS)
-tags:
- etags -o - $(PMS) | ./perl2etags > TAGS
+TAGS: $(PMS)
+ etags -o - $^ | ./perl2etags > $@
clean:
for i in $(DIRS); do $(MAKE) -C $$i clean; done
@@ -52,8 +50,7 @@ $(DIRS):
test_pms: verify_c
./perl2fcalls -excludec -excluderesize_fat::c_rewritten install2
- perl -cw -I. -Ic -Ic/blib/arch install2
- perl -cw -I. -Ic -Ic/blib/arch install_steps_graphical.pm
+ for i in install2 install_steps_*.pm; do perl -cw -I. $$i; done
verify_c:
./verify_c $(PMS)
@@ -90,7 +87,7 @@ install_pms: $(DIRS)
get_needed_files: $(DIRS)
# export PERL_INSTALL_TEST=1 ; strace -f -e trace=file -o '| grep -v "(No such file or directory)" | sed -e "s/[^\"]*\"//" -e "s/\".*//" | grep "^/" | grep -v -e "^/tmp" -e "^/home" -e "^/proc" -e "^/var" -e "^/dev" -e "^/etc" -e "^/usr/lib/rpm" > /tmp/list ' $(PERL) -d install2 < /dev/null
cp -f list /tmp/list
- ls auto/*/*/*.so >> /tmp/list
+ find auto -follow -name "*.so" >> /tmp/list
for i in $(LOCALFILES) `cat /tmp/list` ; do \
ldd $$i 2>/dev/null | grep -v "not a dynamic" | sed -e 's/.*=> //' -e 's/ .*//' | uniq | sort >> /tmp/list; \
@@ -158,13 +155,6 @@ get_needed_files: $(DIRS)
tar xyC $(DEST) -f ../install/install1_pcmcia.tar.bz2 ./etc/pcmcia
-as_root:
- /bin/dd if=/dev/zero of=/tmp/initrd bs=1k count=4000
- $(MKE2FS) /tmp/initrd
- losetup /dev/loop0 /tmp/initrd
- mount /dev/loop0 /mnt/initrd
- chmod a+w /mnt/initrd
-
full_stage2: $(BASE)/depslist $(BASE)/hdlist
sudo rm -rf $(DEST)
mkdir -p $(DEST)
@@ -173,36 +163,4 @@ full_stage2: $(BASE)/depslist $(BASE)/hdlist
stage2:
$(MAKE) install_pms
-
- $(SUDO) rm -rf $(STAGE2TMP)
- install -d $(STAGE2TMP)
- $(SUDO) cp -a $(DEST)/* $(STAGE2TMP)
-
- $(SUDO) umount /mnt/stage2 ||:
- dd if=/dev/zero of=$(STAGE2) bs=1M count=15
- $(MKE2FS) -N 1000 $(STAGE2)
- $(SUDO) mount -t ext2 $(STAGE2) /mnt/stage2 -o loop
-
-# hack to reduce the STAGE2 image
- rm $(STAGE2TMP)/usr/X11R6/bin/XF86_VGA16
- for i in /usr/share/locale /usr/share/keymaps /usr/share/xmodmap $(REP4PMS)/po; do \
- name=`basename $$i` ; \
- (cd $(STAGE2TMP)/$$i ; find * | cpio -o 2>/dev/null | bzip2 > ../$$name.cpio.bz2 ; cd .. ; rm -rf $$name) \
- done
- $(SUDO) cp -a $(STAGE2TMP)/* /mnt/stage2
- $(SUDO) rm -rf $(STAGE2TMP)
-
- $(SUDO) umount $(STAGE2)
- gzip -f -9 $(STAGE2)
-
- @#rm -rf /mnt/initrd/*
- @#cp -a $(DEST)/* /mnt/initrd
- @#sync
- @#dd if=/dev/loop0 | gzip -9 > /tmp/t/Mandrake/base/stage2.img
-
-# function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
-
-#
-# install -s install/install install1/bin/install ; install -s installinit/init install1/bin/init
-# mount /tmp/initrd /mnt/disk/ -o loop ; ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
-
+ ../make_mdkinst_stage2 $(DEST) $(ROOTDEST)/Mandrake/base/mdkinst_stage2
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 16520e10f..6ba3014b7 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -726,7 +726,7 @@ sub main {
}
my $ok = resolutionsConfiguration($o, auto => $::auto, noauto => $::noauto);
- $ok &&= testFinalConfig($o, $::auto);
+ $ok &&= testFinalConfig($o, $::auto) unless $::skiptest;
my $quit;
until ($ok || $quit) {
@@ -743,9 +743,11 @@ sub main {
__("Test again") => sub { $ok = testFinalConfig($o, 1) },
__("Quit") => sub { $quit = 1 },
);
- &{$c{$in->ask_from_list_([''],
+ my $f = $in->ask_from_list_([''],
_("What do you want to do?"),
- [ grep { !ref } @c ])}};
+ [ grep { !ref } @c ]);
+ eval { &{$c{$f}} };
+ $@ =~ /^ask_from_list cancel/ or die;
}
if ($ok) {
diff --git a/perl-install/c/stuff.pm b/perl-install/c/stuff.pm
index 70f2b3222..ea0320225 100644
--- a/perl-install/c/stuff.pm
+++ b/perl-install/c/stuff.pm
@@ -10,8 +10,6 @@ $VERSION = '0.01';
bootstrap c::stuff $VERSION;
-1;
-
sub headerGetEntry {
my ($h, $q) = @_;
$h or log::l("empty header in headerGetEntry"), return;
@@ -27,3 +25,4 @@ sub headerGetEntry {
$q eq 'obsoletes' and return headerGetEntry_string_list($h, RPMTAG_OBSOLETES());
}
+1;
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 4a15ebef9..2067b624c 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -9,7 +9,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
common => [ qw(__ even odd min max sqr sum and_ or_ sign product bool invbool listlength bool2text text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref) ],
functional => [ qw(fold_left compose map_index grep_index map_each grep_each map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
file => [ qw(dirname basename touch all glob_ cat_ output symlinkf chop_ mode typeFromMagic) ],
- system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInCsh substInFile availableRam availableMemory removeXiBSuffix template2file) ],
+ system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInCsh substInFile availableRam availableMemory removeXiBSuffix template2file formatTime) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -447,6 +447,12 @@ sub removeXiBSuffix($) {
$_;
}
+sub formatTime($) {
+ my ($s, $m, $h) = gmtime($_[0]);
+ sprintf "%02d:%02d:%02d", $h, $m, $s;
+}
+
+
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
diff --git a/perl-install/help.pm b/perl-install/help.pm
index 9d9e35aa7..ac62b452d 100644
--- a/perl-install/help.pm
+++ b/perl-install/help.pm
@@ -4,21 +4,17 @@ use common qw(:common);
%steps = (
selectLanguage =>
-#- __("
-#- <h1>Pixel's links</h1>
-#-
-#- <h2>Search</h2>
-#- Quelques sites de recherche :
-#- <a href=\"http://www.metacrawler.com\">MetaCrawler</a>,
-#- <a href=\"http://www.dejanews.com\">dejanews</a>,
-#- <a href=\"http://www.yahoo.fr\">yahoo(fr)</a>,
-#- <a href=\"http://www.yahoo.com\">yahoo</a>,
-#- <a href=\"http://www.infoseek.com\">infoseek</a>,
-#- <a href=\"http://www.altavista.com\">altavista</a>,
-#- <a href=\"http://www.excite.com\">excite</a>
-
-
-__("Choose preferred language for install and system usage."),
+ __("
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+ Quelques sites de recherche :
+
+"),
+#__("Choose preferred language for install and system usage."),
selectKeyboard =>
__("Choose the layout corresponding to your keyboard from the list above"),
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 5226bbbab..b6b928c38 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -31,7 +31,6 @@ use printer;
use modules;
use detect_devices;
use modparm;
-use install_steps_graphical;
use run_program;
#-######################################################################################
@@ -183,8 +182,8 @@ $o = $::o = {
steps => \%installSteps,
orderedSteps => \@orderedInstallSteps,
-#-GOLD base => [ qw(basesystem sed initscripts console-tools mkbootdisk anacron utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm ash setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time tmpwatch util-linux vim-minimal vixie-cron which perl-base) ],
- base => [ qw(basesystem sed initscripts console-tools mkbootdisk anacron utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm ash setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time tmpwatch util-linux vim-minimal vixie-cron which cpio perl) ],
+ base => [ qw(basesystem sed initscripts console-tools mkbootdisk utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm ash setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time tmpwatch util-linux vim-minimal vixie-cron which perl-base) ],
+#-GOLD base => [ qw(basesystem sed initscripts console-tools mkbootdisk anacron utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm ash setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time tmpwatch util-linux vim-minimal vixie-cron which cpio perl) ],
#- for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
#- intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ],
@@ -444,7 +443,7 @@ sub main {
$::beginner = $::expert = $::g_auto_install = 0;
- my $cfg;
+ my ($cfg, $patch);
my %cmdline; map {
my ($n, $v) = split '=';
$cmdline{$n} = $v || 1;
@@ -469,11 +468,15 @@ sub main {
expert => sub { $o->{installClass} = 'expert'; $::expert = 1 },
beginner => sub { $o->{installClass} = 'normal'; $::beginner = 1 },
lnx4win => sub { $o->{lnx4win} = 1 },
- readonly => sub { $o->{partitioning}{readonly} = 1 },
+ readonly => sub { $o->{partitioning}{readonly} = $v ne "0" },
display => sub { $o->{display} = $v },
security => sub { $o->{security} = $v },
test => sub { $::testing = 1 },
+ patch => sub { $patch = 1 },
defcfg => sub { $cfg = $v },
+ newt => sub { $o->{interactive} = "newt" },
+ text => sub { $o->{interactive} = "newt" },
+ stdio => sub { $o->{interactive} = "stdio"},
# ks => sub { $::auto_install = 1; $cfg = $v; },
# kickstart => sub { $::auto_install = 1; $cfg = $v; },
auto_install => sub { $::auto_install = 1; $cfg = $v; },
@@ -481,7 +484,7 @@ sub main {
alawindows => sub { $o->{security} = 0; $o->{partitioning}{clearall} = 1; $o->{bootloader}{crushMbr} = 1 },
g_auto_install => sub { $::testing = $::g_auto_install = 1; $o->{partitioning}{auto_allocate} = 1 },
}}{lc $n}; &$f if $f;
- } %cmdline;
+ } %cmdline;
unlink "/sbin/insmod" unless $::testing;
unlink "/modules/pcmcia_core.o" unless $::testing; #- always use module from archive.
@@ -505,11 +508,18 @@ sub main {
$ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin:$o->{prefix}/usr/X11R6/bin" unless $::g_auto_install;
$ENV{LD_LIBRARY_PATH} = "";
+ if ($o->{interactive} eq "gtk" && availableMemory < 24 * 1024) {
+ log::l("switching to newt install cuz not enough memory");
+ $o->{interactive} = "newt";
+ }
+
if ($::auto_install) {
require 'install_steps_auto_install.pm';
} else {
- require 'install_steps_graphical.pm';
+ $o->{interactive} ||= 'gtk';
+ require"install_steps_$o->{interactive}.pm";
}
+ eval { $o = $::o = install_any::loadO($o, "patch") } if $patch;
eval { $o = $::o = install_any::loadO($o, $cfg) } if $cfg;
$o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt";
@@ -519,12 +529,18 @@ sub main {
$ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin:$o->{prefix}/usr/X11R6/bin";
$ENV{LD_LIBRARY_PATH} = "";
- #- needed very early for install_steps_graphical
+ #- needed very early for install_steps_gtk
eval { $o->{mouse} ||= mouse::detect() };
$::o = $o = $::auto_install ?
install_steps_auto_install->new($o) :
- install_steps_graphical->new($o);
+ $o->{interactive} eq "stdio" ?
+ install_steps_stdio->new($o) :
+ $o->{interactive} eq "newt" ?
+ install_steps_newt->new($o) :
+ $o->{interactive} eq "gtk" ?
+ install_steps_gtk->new($o) :
+ die "unknown install type";
$o->{netc} = network::read_conf("/tmp/network");
if (my ($file) = glob_('/tmp/ifcfg-*')) {
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 8d0495323..e1883aa06 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -400,8 +400,8 @@ sub g_auto_install(;$) {
sub loadO {
my ($O, $f) = @_; $f ||= auto_inst_file;
my $o;
- if ($f eq "floppy") {
- my $f = "auto_inst.cfg";
+ if ($f =~ /^(floppy|patch)$/) {
+ my $f = $f eq "floppy" ? "auto_inst.cfg" : "patch";
unless ($::testing) {
fs::mount(devices::make("fd0"), "/mnt", "vfat", 0);
$f = "/mnt/$f";
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index bcb327c72..afc872b6b 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -11,6 +11,8 @@ use install_any qw(:all);
use partition_table qw(:types);
use detect_devices;
use timezone;
+use Xconfig;
+use Xconfigurator;
use modules;
use run_program;
use lilo;
@@ -473,8 +475,36 @@ sub setupBootloader($) {
}
#------------------------------------------------------------------------------
+sub setupXfreeBefore {
+ my ($o) = @_;
+ $o->{X}{keyboard}{xkb_keymap} ||= keyboard::keyboard2xkb($o->{keyboard});
+ $o->{X}{mouse} = $o->{mouse};
+
+ Xconfig::getinfoFromDDC($o->{X});
+
+ #- keep this here if the package has to be updated.
+ install_any::pkg_install($o, "XFree86");
+}
sub setupXfree {
my ($o) = @_;
+ $o->setupXfreeBefore;
+
+ { local $::testing = 0; #- unset testing
+ local $::auto = 1;
+ local $::skiptest = 1;
+ Xconfigurator::main($o->{prefix}, $o->{X}, $o, $o->{allowFB}, sub {
+ install_any::pkg_install($o, "XFree86-$_[0]");
+ });
+ }
+ $o->setupXfreeAfter;
+}
+sub setupXfreeAfter {
+ my ($o) = @_;
+ if ($o->{X}{card}{server} eq 'FBDev') {
+ unless (install_any::setupFB($o, Xconfigurator::getVGAMode($o->{X}))) {
+ Xconfigurator::rewriteInittab(3) unless $::testing; #- disable automatic start-up of X11 on error.
+ }
+ }
}
#------------------------------------------------------------------------------
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
new file mode 100644
index 000000000..150ff183f
--- /dev/null
+++ b/perl-install/install_steps_gtk.pm
@@ -0,0 +1,811 @@
+package install_steps_gtk;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA);
+
+@ISA = qw(install_steps_interactive interactive_gtk);
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use common qw(:common :file :functional :system);
+use partition_table qw(:types);
+use my_gtk qw(:helpers :wrappers);
+use Gtk;
+use Gtk::XmHTML;
+use devices;
+use fsedit;
+use keyboard;
+use network;
+use modules;
+use printer;
+use install_steps;
+use run_program;
+use install_steps_interactive;
+use Xconfigurator;
+use Xconfig;
+use interactive_gtk;
+use install_any;
+use diskdrake;
+use pkgs;
+use log;
+use help;
+use lang;
+
+#-#####################################################################################
+#-INTERN CONSTANT
+#-#####################################################################################
+my $w_help;
+my $itemsNB = 1;
+my (@background1, @background2);
+my ($width, $height) = (640, 480);
+my ($stepswidth, $stepsheight) = (140, $height);
+my ($logowidth, $logoheight) = ($width - $stepswidth, 40);
+my ($helpwidth, $helpheight) = ($width - $stepswidth, 100);
+my ($windowwidth, $windowheight) = ($width - $stepswidth, $height - $helpheight - $logoheight);
+
+my @themes_vga16 = qw(blue blackwhite savane);
+my @themes = qw(DarkMarble marble3d blueHeart);
+
+my @circle_head = (
+ "19 17 4 1"
+);
+
+my @circle_body = (
+" c None",
+"+ c #FFFFFF",
+" ===== ",
+" ========= ",
+" =+++======= ",
+" =++========== ",
+" ==+============ ",
+" +++============ ",
+" ================o",
+" ================o",
+" ================o",
+" ===============oo",
+" ===============oo",
+" =============oo ",
+" ============ooo ",
+" o=========ooo ",
+" oo=====oooo ",
+" ooooooooo ",
+" ooooo ",
+);
+
+#-my @questionmark_head = (
+#-"39 97 6 1",
+#-" c None",
+#-". c #000000",
+#-"+ c #FFFFFF",
+#-"o c #AAAAAA",
+#-);
+#-my @questionmark_body = (
+#-("OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO") x 10,
+#-"OOOOOOOOOOOOO.......OOOOOOOOOOOOOOOOOOO",
+#-"OOOOOOOOOOOO..OOOOOOO.OOOOOOOOOOOOOOOOO",
+#-"OOOOOOOOOO..OOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOOOOOOO..OOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOOOOO..OOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOOOOO..OOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOOOO..OOOOOOOOOOOOOOOOOOXOOOOOOOOOOO",
+#-"OOOOOOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOOO.OOOOOOOOOOOOOOOOOOOOOXOOOOOOOOOO",
+#-"OOOOO..OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOOO.OOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOOO",
+#-"OOOO..OOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOO",
+#-"OOOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOOO.OOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOO",
+#-"OOO..OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO",
+#-"OOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOO",
+#-"OO..OOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOO",
+#-"OOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOO",
+#-"OO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"OO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"O..OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"OO.OOOOOOOOOOOoo+++++ooOOOOOOOOOOXOOOOO",
+#-"O.OOOOOOOOOOo+++o+++++++oOOOOOOOOOXOOOO",
+#-"O.OOOOOOOOO+++OOOOo+++++++OOOOOOOOXOOOO",
+#-"O.OOOOOOOOo++oOOOOOo++++++oOOOOOOOXOOOO",
+#-"O.OOOOOOOo+++oOOOOOO+++++++OOOOOOOXOOOO",
+#-"..OOOOOOOo++++OOOOOOo++++++oOOOOOOXOOOO",
+#-"O.OOOOOOO+++++oOOOOOo+++++++OOOOOOXOOOO",
+#-".OOOOOOOO++++++OOOOOo+++++++OOOOOOOXOOO",
+#-".OOOOOOOO++++++OOOOOo+++++++OOOOOOXOOOO",
+#-".OOOOOOOOo++++oOOOOOo++++++oOOOOOOOXOOO",
+#-".OOOOOOOOOo++oOOOOOOo++++++oOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOOO+++++++OOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOOO++++++OOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOOo+++++oOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOO+++++OOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOo+++oOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOO+++oOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOo++OOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOO++OOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOO+oOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOO+OOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOO+OOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOoOOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOO",
+#-"O.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOO",
+#-"OOOOOOOOOOOOOOOOoooOOOOOOOOOOOOOOOOXOOO",
+#-".OOOOOOOOOOOOOO+++++OOOOOOOOOOOOOOXOOOO",
+#-"O.OOOOOOOOOOOO++++++oOOOOOOOOOOOOOXXOOO",
+#-"O.OOOOOOOOOOOo+++++++OOOOOOOOOOOOOXOOOO",
+#-"O.OOOOOOOOOOOo+++++++OOOOOOOOOOOOOXOOOO",
+#-"O.OOOOOOOOOOOo+++++++OOOOOOOOOOOOOXOOOO",
+#-"OOOOOOOOOOOOOO++++++oOOOOOOOOOOOOOXOOOO",
+#-"O.OOOOOOOOOOOOO+++++OOOOOOOOOOOOOXXOOOO",
+#-"OO.OOOOOOOOOOOOOoooOOOOOOOOOOOOOOOXOOOO",
+#-"OO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"OO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOXXOOOOO",
+#-"OOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOO",
+#-"OOO.OOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOO",
+#-"OOOO.OOOOOOOOOOOOOOOOOOOOOOOOOOXXOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOO",
+#-"OOOOO.OOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXXOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOO",
+#-"OOOOOO.OOOOOOOOOOOOOOOOOOOOOOXXOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOOXXOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOXXOOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOXXXOOOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOOOOOOOOOOOXOOOOOOOOOOOOO",
+#-"OOOOOOOOOOOOXOOOOOOOOOOXXXOOOOOOOOOOOOO",
+#-"OOOOOOOOOOOOOOXOOOOOOXXXOOOOOOOOOOOOOOO",
+#-"OOOOOOOOOOOOOOOXXXXXXXOOOOOOOOOOOOOOOOO",
+#-("OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO") x 10);
+
+my @red_circle = (@circle_head, "= c #FF0000", "o c #AA5500", @circle_body);
+my @orange_circle = (@circle_head, "= c #FFAA00", "o c #AA5500", @circle_body);
+my @green_circle = (@circle_head, "= c #00FF00", "o c #00AA00", @circle_body);
+
+#-######################################################################################
+#- In/Out Steps Functions
+#-######################################################################################
+sub new($$) {
+ my ($type, $o) = @_;
+
+ my $old = $SIG{__DIE__};
+ $SIG{__DIE__} = sub { $_[0] !~ /my_gtk\.pm/ and goto $old };
+
+ $ENV{DISPLAY} = $o->{display} || ":0";
+ unless ($::testing) {
+ $my_gtk::force_focus = $ENV{DISPLAY} eq ":0";
+
+ my $f = "/tmp/Xconf";
+ createXconf($f, @{$o->{mouse}}{"XMOUSETYPE", "device"});
+
+ if ($ENV{DISPLAY} eq ":0") {
+ my $launchX = sub {
+ my $ok = 1;
+ local $SIG{CHLD} = sub { $ok = 0 };
+ unless (fork) {
+ exec $_[0], "-kb", "-dpms","-s" ,"240", "-allowMouseOpenFail", "-xf86config", $f or exit 1;
+ }
+ foreach (1..10) {
+ sleep 1;
+ return 0 if !$ok;
+ return 1 if c::Xtest($ENV{DISPLAY});
+ }
+ 0;
+ };
+
+ if (listlength(cat_("/proc/fb"))) {
+ &$launchX("XF86_FBDev");
+ $o->{allowFB} = 1; #- keep in mind FB is used.
+ } else {
+ my $dir = "/usr/X11R6/bin";
+ unless (-x "$dir/XF86_VGA16") {
+ unlink "$dir/XF86_FBDev";
+ local *F; open F, ">$dir/XF86_VGA16" or die '';
+ local $/ = \ (16 * 1024);
+ my $f = install_any::getFile("$dir/XF86_VGA16") or die '';
+ syswrite F, $_ foreach <$f>;
+ chmod 0755, "$dir/XF86_VGA16";
+ }
+ &$launchX("XF86_VGA16");
+ }
+ }
+ }
+ @themes = @themes_vga16 if $o->{simple_themes} || !$o->{display} && !($o->{allowFB} ||= $::testing);
+
+ install_theme($o);
+ create_logo_window($o);
+
+ $my_gtk::force_center = [ $width - $windowwidth, $logoheight, $windowwidth, $windowheight ];
+
+ (bless {}, ref $type || $type)->SUPER::new($o);
+}
+
+sub enteringStep {
+ my ($o, $step) = @_;
+
+ $o->SUPER::enteringStep($step);
+ create_steps_window($o);
+ create_help_window($o);
+}
+sub leavingStep {
+ my ($o, $step) = @_;
+ $o->SUPER::leavingStep($step);
+}
+
+
+
+#-######################################################################################
+#- Steps Functions
+#-######################################################################################
+sub selectLanguage {
+ my ($o) = @_;
+ $o->SUPER::selectLanguage;
+ Gtk->set_locale;
+ install_theme($o);
+}
+
+#------------------------------------------------------------------------------
+sub doPartitionDisks($$) {
+ my ($o, $hds, $raid) = @_;
+
+ while (1) {
+ diskdrake::main($hds, $raid, interactive_gtk->new, $o->{partitions});
+ if (!grep { isSwap($_) } fsedit::get_fstab(@{$o->{hds}})) {
+ if ($::beginner) {
+ $o->ask_warn('', _("You must have a swap partition"));
+ } elsif (!$::expert) {
+ $o->ask_okcancel('', _("You don't have a swap partition\n\nContinue anyway?")) and last;
+ } else { last }
+ } else { last }
+ }
+}
+
+#------------------------------------------------------------------------------
+sub choosePackages {
+ my ($o, $packages, $compss, $compssUsers, $first_time) = @_;
+
+ return if $::beginner;
+ chooseSizeToInstall(@_);
+ install_steps_interactive::choosePackages(@_);
+ choosePackagesTree(@_) if $::expert;
+}
+sub chooseSizeToInstall {
+ my ($o, $packages, $compss, $compssUsers, $first_time) = @_;
+ my $availableSpace = int(install_any::getAvailableSpace($o) / sqr(1024));
+ my $default = pkgs::correctSize((sum map { $_->{size} } grep { $_->{selected} } values %$packages) / sqr(1024) || $availableSpace * 0.7);
+ my $w = my_gtk->new('');
+ my $adj = create_adjustment($default, 100, $availableSpace);
+ my $spin = gtkset_usize(new Gtk::SpinButton($adj, 0, 0), 100, 0);
+
+ gtkadd($w->{window},
+ gtkpack(new Gtk::VBox(0,20),
+ create_packtable({ col_spacings => 10 },
+ [ _("Choose the size you want to install"), $spin, _("MB"), ],
+ [ undef, new Gtk::HScrollbar($adj) ],
+ ),
+ create_okcancel($w)
+ )
+ );
+ $spin->signal_connect(activate => sub { $w->{retval} = 1; Gtk->main_quit });
+ $spin->grab_focus();
+ $w->main or return;
+
+ $_->{selected} = 0 foreach values %$packages;
+ pkgs::setSelectedFromCompssList($o->{compssListLevels}, $o->{packages}, pkgs::invCorrectSize($spin->get_value_as_int) * sqr(1024), $o->{installClass}, $o->{lang}, $o->{isUpgrade});
+}
+sub choosePackagesTree {
+ my ($o, $packages, $compss, $compssUsers) = @_;
+ my $availableSpace = int(install_any::getAvailableSpace($o) / sqr(1024));
+ my $w = my_gtk->new('');
+ add2hash_($o->{packages_}, { show_level => 0 }); #- keep show more or less 80 });
+
+ my ($current, $ignore, $showall, $selectall, $w_size, $info_widget, $showall_button, $selectall_button, $go, %items) = 0, 0, 0, 0;
+ my $details = new Gtk::VBox(0,0);
+ $compss->{tree} = new Gtk::Tree();
+ $compss->{tree}->set_selection_mode('multiple');
+
+ my $clean; $clean = sub {
+ my ($p) = @_;
+ foreach (values %{$p->{childs}}) {
+ &$clean($_) if $_->{childs};
+ delete $_->{itemNB};
+ delete $_->{tree};
+ delete $_->{packages_item};
+ }
+ }; &$clean($compss);
+
+ my $update = sub {
+ my $size = 0;
+ $ignore = 1;
+ foreach (grep { $_->[0] } values %items) {
+ $compss->{tree}->unselect_child($_->[0]);
+ $compss->{tree}->select_child($_->[0]) if $_->[1]{selected};
+ }
+ $ignore = 0;
+
+ foreach (values %$packages) {
+ $size += $_->{size} - ($_->{installedCumulSize} || 0) if $_->{selected}; #- on upgrade, installed packages will be removed.
+ }
+
+ $w_size->set(_("Total size: ") . int (pkgs::correctSize($size / sqr(1024))) . " / $availableSpace " . _("MB") );
+ };
+ my $new_item = sub {
+ my ($p, $name, $parent) = @_;
+ my $w = create_treeitem($name);
+ $items{++$itemsNB} = [ $w, $p ];
+ $parent->{packages_item}{$itemsNB} = undef if $parent;
+ $w->show;
+ $w->set_sensitive(!$p->{base} && !$p->{installed});
+ $w->signal_connect(focus_in_event => sub {
+ my $p = pkgs::getHeader($p);
+ gtktext_insert($info_widget,
+ _("Version: %s\n", c::headerGetEntry($p, 'version') . '-' . c::headerGetEntry($p, 'release')) .
+ _("Size: %d KB\n", c::headerGetEntry($p, 'size') / 1024) .
+
+ formatLines(c::headerGetEntry($p, 'description')));
+ }) unless $p->{childs};
+ $itemsNB;
+ };
+
+ $compss->{tree}->signal_connect(selection_changed => sub {
+ $ignore and return;
+
+ my %s; @s{$_[0]->selection} = ();
+ my @changed;
+ #- needs to find @changed first, _then_ change the selected, otherwise
+ #- we won't be able to find the changed
+ foreach (values %items) {
+ push @changed, $_->[1] if ($_->[1]{selected} xor exists $s{$_->[0]});
+ }
+ #- works before @changed is (or must be!) one element
+ foreach (@changed) {
+ if ($_->{childs}) {
+ my $s = invbool \$_->{selected};
+ my $f; $f = sub {
+ my ($p) = @_;
+ $p->{itemNB} or return;
+ if ($p->{packages}) {
+ foreach (keys %{$p->{packages_item} || {}}) {
+ my ($a, $b) = @{$items{$_}};
+ $a and pkgs::set($packages, $b, $s);
+ }
+ } else {
+ foreach (values %{$p->{childs}}) {
+ $_->{selected} = $s;
+ &$f($_);
+ }
+ }
+ }; &$f($_);
+#- } elsif ($_->{base}) {
+#- $o->ask_warn('', _("Sorry, i won't unselect this package. The system needs it"));
+#- } elsif ($_->{installed}) {
+#- $o->ask_warn('', _("Sorry, i won't select this package. A more recent version is already installed"));
+ } else {
+ pkgs::toggle($packages, $_);
+ }
+ }
+ &$update();
+ });
+
+ my $select_add = sub {
+ my ($ind, $level) = @{$o->{packages_}}{"ind", "select_level"};
+ $level = max(0, min(100, ($level + $_[0])));
+ $o->{packages_}{select_level} = $level;
+
+ pkgs::unselect_all($packages);
+ foreach (pkgs::allpackages($packages)) {
+ pkgs::select($packages, $_) if $_->{values}[$ind] >= $level;
+ }
+ &$update;
+ };
+
+ my $show_add = sub {
+ my ($ind, $level) = @{$o->{packages_}}{"ind", "show_level"};
+ $level = max(0, min(90, ($level + $_[0])));
+ $o->{packages_}{show_level} = $level;
+
+ my $update_tree = sub {
+ my $P = shift;
+ my $i = 0; foreach (@_) {
+ my ($flag, $itemNB, $q) = @$_;
+ my $item = $items{$flag || $itemNB}[0] if $flag || $itemNB;
+ if ($flag) {
+ $P->{tree}->insert($item, $i) if $flag ne "1";
+ $item->set_subtree($q->{tree}) if $flag ne "1" && $q->{tree};
+ $i++;
+ } elsif ($itemNB) {
+ delete $items{$itemNB};
+ delete $P->{packages_item}{$itemNB};
+ $P->{tree}->remove_item($item) if $P->{tree};
+ }
+ }
+ };
+ my $f; $f = sub {
+ my ($p) = @_;
+ if ($p->{packages}) {
+ my %l; $l{$items{$_}[1]} = $_ foreach keys %{$p->{packages_item}};
+ map {
+ [ $_->{values}[$ind] >= $level ?
+ ($l{$_} ? 1 : &$new_item($_, $_->{name}, $p)) : '', $l{$_}, $_ ];
+ } sort {
+ $a->{name} cmp $b->{name} } @{$p->{packages}};
+ } else {
+ map {
+ my $P = $p->{childs}{$_};
+ my @L; @L = &$f($P) if !$P->{values} || $P->{values}[$ind] > ($::expert ? -1 : 0);
+ if (grep { $_->[0] } @L) {
+ my $r = $P->{tree} ? 1 : do {
+ my $t = $P->{tree} = new Gtk::Tree(); $t->show;
+ $P->{itemNB} = &$new_item($P, $_);
+ };
+ &$update_tree($P, @L);
+ [ $r, $P->{itemNB}, $P ];
+ } else {
+ &$update_tree($P, @L);
+ delete $P->{tree};
+ [ '', delete $P->{itemNB}, $P ];
+ }
+ } sort keys %{$p->{childs} || {}};
+ }
+ };
+ $ignore = 1;
+ &$update_tree($compss, &$f($compss));
+ &$update;
+ $ignore = 0;
+ };
+
+ gtkadd($w->{window}, gtkpack_(new Gtk::VBox(0,5),
+ 0, _("Choose the packages you want to install"),
+ 1, gtkpack(new Gtk::HBox(0,0),
+ createScrolledWindow($compss->{tree}),
+ gtkadd(gtkset_usize(new Gtk::Frame(_("Info")), 150, 0),
+ createScrolledWindow($info_widget = new Gtk::Text),
+ ),
+ ),
+ 0, gtkpack_(new Gtk::HBox(0,0), 0, $w_size = new Gtk::Label('')),
+ 0, gtkpack(new Gtk::HBox(0,10),
+ map { $go ||= $_; $_ }
+ map { gtksignal_connect(new Gtk::Button($_->[0]), "clicked" => $_->[1]) }
+ [ _("Install") => sub { $w->{retval} = 1; Gtk->main_quit } ],
+ #- keep show more or less [ _("Show less") => sub { &$show_add(+10) } ],
+ #- keep show more or less [ _("Show more") => sub { &$show_add(-10) } ],
+ )
+ ));
+ $w->{window}->set_usize(map { $_ - 2 * $my_gtk::border - 4 } $windowwidth, $windowheight);
+ $w->show;
+ &$show_add(0);
+ &$update();
+ $go->grab_focus;
+ $w->main;
+}
+
+#------------------------------------------------------------------------------
+sub installPackages {
+ my ($o, $packages) = @_;
+
+ my ($current_total_size, $last_size, $nb, $total_size, $start_time, $last_dtime);
+
+ my $w = my_gtk->new(_("Installing"), grab => 1);
+ $w->{window}->set_usize($windowwidth * 0.8, $windowheight * 0.5);
+ my $text = new Gtk::Label;
+ my ($msg, $msg_time_remaining, $msg_time_total) = map { new Gtk::Label } (1..3);
+ my ($progress, $progress_total) = map { new Gtk::ProgressBar } (1..2);
+ gtkadd($w->{window}, gtkadd(new Gtk::EventBox,
+ gtkpack(new Gtk::VBox(0,10),
+ _("Please wait, "), $msg, $progress,
+ create_packtable({},
+ [_("Time remaining "), $msg_time_remaining],
+ [_("Total time "), $msg_time_total],
+ ),
+ $text,
+ $progress_total,
+ )));
+ $msg->set(_("Preparing installation"));
+ $w->sync;
+
+ my $old = \&log::ld;
+ local *log::ld = sub {
+ my $m = shift;
+ if ($m =~ /^starting installation:/) {
+ $nb = $_[0];
+ $total_size = $_[2]; $current_total_size = 0;
+ $start_time = time();
+ $msg->set(join '', @_);
+ $w->flush;
+ } elsif ($m =~ /^starting installing/) {
+ $progress->update(0);
+ my $name = $_[0];
+ $msg->set(_("Installing package %s", $name));
+ $current_total_size += $last_size;
+ $last_size = c::headerGetEntry($o->{packages}{$name}{header}, 'size');
+ $text->set((split /\n/, c::headerGetEntry($o->{packages}{$name}{header}, 'summary'))[0] || '');
+ $w->flush;
+ } elsif ($m =~ /^progressing installation/) {
+ $progress->update($_[2] ? $_[0] / $_[2] : 0);
+
+ my $dtime = time() - $start_time;
+ my $ratio = $total_size ? ($_[0] + $current_total_size) / $total_size : 0;
+ my $total_time = $ratio ? $dtime / $ratio : time();
+
+ $progress_total->update($ratio);
+ if ($dtime != $last_dtime) {
+ $msg_time_total->set(formatTime($total_time));
+ $msg_time_remaining->set(formatTime(max($total_time - $dtime, 0)));
+ $last_dtime = $dtime;
+ }
+ $w->flush;
+ } else { goto $old }
+ };
+ catch_cdie { $o->install_steps::installPackages($packages); }
+ sub {
+ if ($@ =~ /^error ordering package list: (.*)/) {
+ $o->ask_yesorno('', [
+_("There was an error ordering packages:"), $1, _("Go on anyway?") ], 1) and return 1;
+ ${$_[0]} = "already displayed";
+ }
+ 0;
+ };
+ $w->destroy;
+}
+
+
+
+
+#------------------------------------------------------------------------------
+sub load_rc($) {
+ if (my ($f) = grep { -r $_ } map { "$_/$_[0].rc" } (".", "/usr/share", dirname(__FILE__))) {
+ Gtk::Rc->parse($f);
+ foreach (cat_($f)) {
+ if (/style\s+"background"/ .. /^\s*$/) {
+ @background1 = map { $_ * 256 * 256 } split ',', $1 if /NORMAL.*\{(.*)\}/;
+ @background2 = map { $_ * 256 * 256 } split ',', $1 if /PRELIGHT.*\{(.*)\}/;
+ }
+ }
+ }
+}
+
+sub install_theme {
+ my ($o, $theme) = @_;
+ $o->{theme} = $theme || $o->{theme} || $themes[0];
+
+ gtkset_mousecursor(68);
+
+ load_rc($_) foreach "themes-$o->{theme}", "install", "themes";
+
+ if (my ($font, $font2) = lang::get_x_fontset($o->{lang})) {
+ $font2 ||= $font;
+ Gtk::Rc->parse_string(qq(
+style "default-font"
+{
+ fontset = "$font"
+}
+style "steps"
+{
+ fontset = "$font2"
+}
+widget "*" style "default-font"
+widget "*Steps*" style "steps"
+
+));
+ }
+ gtkset_background(@background1);# unless $::testing;
+
+ create_logo_window($o);
+ create_help_window($o);
+}
+
+#------------------------------------------------------------------------------
+sub create_help_window {
+ my ($o) = @_;
+
+# $o->{help_window}->destroy if $o->{help_window};
+
+ my $w;
+ if ($w = $o->{help_window}) {
+ $_->destroy foreach $w->{window}->children;
+ } else {
+ $w = bless {}, 'my_gtk';
+ $w->{rwindow} = $w->{window} = new Gtk::Window;
+ $w->{rwindow}->set_uposition($width - $helpwidth, $height - $helpheight);
+ $w->{rwindow}->set_usize($helpwidth, $helpheight);
+ $w->sync;
+ }
+
+#- my $b = new Gtk::Button;
+#- $b->signal_connect(clicked => sub {
+#- my $w = my_gtk->new('', grab => 1, force_position => [ $stepswidth, $logoheight ]);
+#- $w->{rwindow}->set_usize($logowidth, $height - $logoheight);
+#- gtkadd($w->{window},
+#- gtkpack_(new Gtk::VBox(0,0),
+#- 1, createScrolledWindow(gtktext_insert(new Gtk::Text,
+#- formatAlaTeX(translate($help::steps_long{$o->{step}})))),
+#- 0, gtksignal_connect(new Gtk::Button(_("Ok")), "clicked" => sub { Gtk->main_quit }),
+#- ));
+#- $w->main;
+#- });
+#- my @l = (@questionmark_head,
+#- join('', "X c #", map { sprintf "%02X", $_ / 256 } @background1),
+#- join('', "O c #", map { sprintf "%02X", $_ / 256 } @background2),
+#- @questionmark_body);
+#- my @pixmap = Gtk::Gdk::Pixmap->create_from_xpm_d($w->{window}->window, undef, @l);
+#- gtkadd($b, new Gtk::Pixmap(@pixmap));
+
+ Gtk::XmHTML->init;
+ gtkadd($w->{window},
+ gtkpack_(new Gtk::HBox(0,-2),
+#- 0, $b,
+ 1, createScrolledWindow($w_help = new Gtk::XmHTML)));
+#- 1, createScrolledWindow($w_help = new Gtk::Text)));
+ $w_help->source($o->{step} ? translate($o->{steps}{$o->{step}}{help}) : '');
+#- gtktext_insert($w_help, $o->{step} ? formatAlaTeX(translate($o->{steps}{$o->{step}}{help})) : '');
+
+ $w->show;
+ $o->{help_window} = $w;
+}
+
+#------------------------------------------------------------------------------
+sub create_steps_window {
+ my ($o) = @_;
+
+ $o->{steps_window}->destroy if $o->{steps_window};
+ my %reachableSteps if 0;
+ %reachableSteps = ();
+
+ my $w = bless {}, 'my_gtk';
+ $w->{rwindow} = $w->{window} = new Gtk::Window;
+ $w->{rwindow}->set_uposition(0, 0);
+ $w->{rwindow}->set_usize($stepswidth, $stepsheight);
+ $w->{rwindow}->set_name("Steps");
+ $w->{rwindow}->set_events('button_press_mask');
+ $w->{rwindow}->signal_connect(button_press_event => sub {
+ $::setstep or return;
+ my $Y = $_[1]{'y'};
+ map_each {
+ my (undef, $y, undef, $height) = @{$::b->allocation};
+ $y <= $Y && $Y < $y + $height and die "setstep $::a\n";
+ } %reachableSteps;
+ });
+ $w->show;
+
+ gtkadd($w->{window},
+ gtkpack_(new Gtk::VBox(0,0),
+ (map { 1, $_ } map {
+ my $step = $o->{steps}{$_};
+ my $circle =
+ $step->{done} && \@green_circle ||
+ $step->{entered} && \@orange_circle ||
+ \@red_circle;
+ my @pixmap = Gtk::Gdk::Pixmap->create_from_xpm_d($w->{window}->window, undef, @$circle);
+
+ my $w = new Gtk::Label(translate($step->{text}));
+
+ $w->set_name("Steps" . ($step->{reachable} && "Reachable"));
+ my $b = new Gtk::HBox(0,5);
+ gtkpack_($b, 0, new Gtk::Pixmap(@pixmap), 0, $w);
+
+ $reachableSteps{$_} = $b if $step->{reachable};
+ $b;
+ } grep { !(($::beginner || !$o->{installClass}) && $o->{steps}{$_}{beginnerHidden}) } @{$o->{orderedSteps}}),
+ 0, gtkpack(new Gtk::HBox(0,0), map {
+ my $t = $_;
+ my $w = new Gtk::Button('');
+ $w->set_name($t);
+ $w->set_usize(0, 7);
+ gtksignal_connect($w, clicked => sub { install_theme($o, $t); die "theme_changed\n" });
+ } @themes)));
+ $w->show;
+ $o->{steps_window} = $w;
+}
+
+#------------------------------------------------------------------------------
+sub create_logo_window() {
+ my ($o) = @_;
+ gtkdestroy($o->{logo_window});
+ my $w = bless {}, 'my_gtk';
+ $w->{rwindow} = $w->{window} = new Gtk::Window;
+ $w->{rwindow}->set_uposition($stepswidth, 0);
+ $w->{rwindow}->set_usize($logowidth, $logoheight);
+ $w->{rwindow}->set_name("background");
+ $w->show;
+ my $file = "logo-mandrake.xpm";
+ -r $file or $file = "/usr/share/$file";
+ if (-r $file) {
+ my $ww = $w->{window};
+ my @logo = Gtk::Gdk::Pixmap->create_from_xpm($ww->window, $ww->style->bg('normal'), $file);
+ gtkadd($ww, new Gtk::Pixmap(@logo));
+ }
+ $o->{logo_window} = $w;
+}
+
+#------------------------------------------------------------------------------
+sub createXconf($$$) {
+ my ($file, $mouse_type, $mouse_dev) = @_;
+ $mouse_type ||= "Microsoft";
+ $mouse_dev = devices::make($mouse_dev || "ttyS0");
+
+ local *F;
+ open F, ">$file" or die "can't create X configuration file $file";
+ print F <<END;
+Section "Files"
+ FontPath "/usr/X11R6/lib/X11/fonts"
+EndSection
+
+Section "Keyboard"
+ Protocol "Standard"
+ AutoRepeat 500 5
+
+ LeftAlt Meta
+ RightAlt Meta
+ ScrollLock Compose
+ RightCtl Control
+EndSection
+
+Section "Pointer"
+ Protocol "$mouse_type"
+ Device "$mouse_dev"
+ Emulate3Buttons
+ Emulate3Timeout 50
+EndSection
+
+
+Section "Monitor"
+ Identifier "My Monitor"
+ VendorName "Unknown"
+ ModelName "Unknown"
+ HorizSync 31.5-35.5
+ VertRefresh 50-70
+ Modeline "640x480" 25.175 640 664 760 800 480 491 493 525
+ Modeline "640x480" 28.3 640 664 760 800 480 491 493 525
+EndSection
+
+
+Section "Device"
+ Identifier "Generic VGA"
+ VendorName "Unknown"
+ BoardName "Unknown"
+ Chipset "generic"
+EndSection
+
+
+Section "Screen"
+ Driver "svga"
+ Device "Generic VGA"
+ Monitor "My Monitor"
+ Subsection "Display"
+ Modes "640x480"
+ ViewPort 0 0
+ EndSubsection
+EndSection
+
+Section "Screen"
+ Driver "vga16"
+ Device "Generic VGA"
+ Monitor "My Monitor"
+ Subsection "Display"
+ Modes "640x480"
+ ViewPort 0 0
+ EndSubsection
+EndSection
+
+Section "Screen"
+ Driver "fbdev"
+ Device "Generic VGA"
+ Monitor "My Monitor"
+ Subsection "Display"
+ Depth 16
+ Modes "default"
+ ViewPort 0 0
+ EndSubsection
+EndSection
+END
+
+}
+#- ModeLine "640x480" 28 640 672 768 800 480 490 492 525
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; #
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 5e8eb1c33..886328b6b 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -14,6 +14,8 @@ use common qw(:common :file :functional :system);
use partition_table qw(:types);
use install_steps;
use pci_probing::main;
+use Xconfig;
+use Xconfigurator;
use install_any;
use detect_devices;
use timezone;
@@ -193,7 +195,7 @@ sub choosePartitionsToFormat($$) {
$o->SUPER::choosePartitionsToFormat($fstab);
- my @l = grep { $_->{mntpoint} && !($::beginner && isSwap($_)) } @$fstab;
+ my @l = grep { !$_->{isFormatted} && $_->{mntpoint} && !($::beginner && isSwap($_)) } @$fstab;
$_->{toFormat} = 1 foreach grep { $::beginner && isSwap($_) } @$fstab;
return if $::beginner && 0 == grep { ! $_->{toFormat} } @l;
@@ -240,6 +242,28 @@ sub choosePackages {
[ map { \$o->{compssUsersChoice}{$_} } keys %$compssUsers ]
);
}
+
+#------------------------------------------------------------------------------
+sub installPackages {
+ my ($o, $packages) = @_;
+ my ($current, $total) = 0;
+
+ my $w = $o->wait_message(_("Installing"), _("Preparing installation"));
+
+ my $old = \&log::ld;
+ local *log::ld = sub {
+ my $m = shift;
+ if ($m =~ /^starting installation:/) {
+ $total = $_[2];
+ } elsif ($m =~ /^starting installing/) {
+ my $name = $_[0];
+ $w->set(_("Installing package %s\n%d%%", $name, 100 * $current / $total));
+ $current += c::headerGetEntry($o->{packages}{$name}{header}, 'size');
+ } else { goto $old }
+ };
+ $o->SUPER::installPackages($packages);
+}
+
#------------------------------------------------------------------------------
sub configureNetwork($) {
my ($o, $first_time) = @_;
@@ -847,13 +871,15 @@ sub miscellaneousNetwork {
sub miscellaneous {
my ($o, $clicked) = @_;
my %l = (
- #- abusive 0 => _("Windows(TM)"),
- #- unused 1 => _("Poor"),
+ 0 => _("Windows(TM)"),
+ 1 => _("Poor"),
2 => _("Low"),
3 => _("Medium"),
4 => _("High"),
- #- unused 5 => _("Paranoid"),
+ 5 => _("Paranoid"),
);
+ delete @l{0,4,5} unless $::expert;
+
my $u = $o->{miscellaneous} ||= {};
exists $u->{LAPTOP} or $u->{LAPTOP} = 1;
my $s = $o->{security};
@@ -868,7 +894,7 @@ sub miscellaneous {
],
[ { val => \$u->{LAPTOP}, type => 'bool' },
{ val => \$u->{HDPARM}, type => 'bool', text => _("(may cause disk problems)") },
- { val => \$s, list => [ map { $l{$_} } ikeys %l ] },
+ { val => \$s, list => [ map { $l{$_} } ikeys %l ], not_edit => 1 },
\$u->{memsize},
],
complete => sub {
@@ -881,6 +907,32 @@ sub miscellaneous {
}
#------------------------------------------------------------------------------
+sub setupXfree {
+ my ($o) = @_;
+ $o->setupXfreeBefore;
+
+ #- maybe better to do before getinfoFromDDC (probe for changed config).
+ if ($o->{isUpgrade} && -r "$o->{prefix}/etc/X11/XF86Config" &&
+ ($::beginner || $o->ask_yesorno('', _("Use existing configuration for X11?"), 1))) {
+ Xconfig::getinfoFromXF86Config($o->{X}, $o->{prefix});
+ }
+ #- strange, xfs must not be started twice...
+ #- trying to stop and restart it does nothing good too...
+ my $xfs_started if 0;
+ run_program::rooted($o->{prefix}, "/etc/rc.d/init.d/xfs", "start") unless $xfs_started;
+ $xfs_started = 1;
+
+ { local $::testing = 0; #- unset testing
+ local $::auto = $::beginner;
+
+ Xconfigurator::main($o->{prefix}, $o->{X}, $o, $o->{allowFB}, sub {
+ install_any::pkg_install($o, "XFree86-$_[0]");
+ });
+ }
+ $o->setupXfreeAfter;
+}
+
+#------------------------------------------------------------------------------
sub exitInstall {
my ($o, $alldone) = @_;
diff --git a/perl-install/install_steps_newt.pm b/perl-install/install_steps_newt.pm
index 1383ad372..b35d47e9d 100644
--- a/perl-install/install_steps_newt.pm
+++ b/perl-install/install_steps_newt.pm
@@ -11,6 +11,40 @@ use vars qw(@ISA);
#-######################################################################################
use install_steps_interactive;
use interactive_newt;
+use common qw(:common);
+
+my $banner = __();
+
+sub banner {
+ my $banner = translate(__("Linux-Mandrake Installation %s"));
+ my $l = first(Newt::GetScreenSize) - length($banner) - length($_[0]) + 1;
+ Newt::DrawRootText(0, 0, sprintf($banner, ' ' x $l . $_[0]));
+}
+
+sub new($$) {
+ my ($type, $o) = @_;
+
+ interactive_newt->new;
+
+ banner('');
+ Newt::PushHelpLine(_(" <Tab>/<Alt-Tab> between elements | <Space> selects | <F12> next screen "));
+
+ $o->{partitioning}{readonly} = 1; #- needed til diskdrake is graphic only...
+
+ (bless {}, ref $type || $type)->SUPER::new($o);
+}
+
+sub enteringStep {
+ my ($o, $step) = @_;
+ $o->SUPER::enteringStep($step);
+ banner(translate($o->{steps}{$step}{text}));
+}
+
+sub exitInstall {
+ &install_steps_interactive::exitInstall;
+ interactive_newt::end;
+}
+
1;
diff --git a/perl-install/install_steps_stdio.pm b/perl-install/install_steps_stdio.pm
index a3c634b4d..734c4f451 100644
--- a/perl-install/install_steps_stdio.pm
+++ b/perl-install/install_steps_stdio.pm
@@ -14,11 +14,16 @@ use install_steps_interactive;
use install_any;
use log;
-1;
+sub new($$) {
+ my ($type, $o) = @_;
+
+ $o->{partitioning}{readonly} = 1; #- needed til diskdrake is graphic only...
+ (bless {}, ref $type || $type)->SUPER::new($o);
+}
sub enteringStep {
my ($o, $step) = @_;
- print _("Entering step `%s'\n", $o->{steps}{$step}{text});
+ print _("Entering step `%s'\n", translate($o->{steps}{$step}{text}));
$o->SUPER::enteringStep($step);
}
sub leavingStep {
@@ -27,49 +32,4 @@ sub leavingStep {
print "--------\n";
}
-sub installPackages {
- my $o = shift;
-
- my $old = \&log::ld;
- local *log::ld = sub {
- my $m = shift;
- if ($m =~ /^starting installing/) {
- my $name = first($_[0] =~ m|([^/]*)-.+?-|);
- print("installing package $name");
- } else { goto $old }
- };
- $o->SUPER::installPackages(@_);
-}
-
-
-sub setRootPassword($) {
- my ($o) = @_;
-
- my (%w);
- do {
- $w{password} and print "You must enter the same password, please try again\n";
- print "Password: "; $w{password} = $o->readln();
- print "Password (again for confirmation): ";
- } until ($w{password} eq $o->readln());
-
- $o->{default}{rootPassword} = $w{password};
- $o->SUPER::setRootPassword;
-}
-
-sub addUser($) {
- my ($o) = @_;
- my %w;
- print "\nCreating a normal user account:\n";
- print "Name: "; $w{name} = $o->readln() or return;
- do {
- $w{password} and print "You must enter the same password, please try again\n";
- print "Password: "; $w{password} = $o->readln();
- print "Password (again for confirmation): ";
- } until ($w{password} eq $o->readln());
- print "Real name: "; $w{realname} = $o->readln();
-
- $w{shell} = $o->ask_from_list('', 'Shell', [ install_any::shells($o) ], "/bin/bash");
-
- $o->{default}{user} = { map { $_ => $w{$_}->get_text } qw(name password realname shell) };
- $o->SUPER::addUser;
-}
+1;
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 9bdb53042..45f3cea66 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -81,18 +81,13 @@ sub ask_from_list2_($$$$;$) {
sub ask_from_list2($$$$;$) {
my ($o, $title, $message, $l, $def) = @_;
- $message = ref $message ? $message : [ $message ];
-
@$l > 10 and $l = [ sort @$l ];
- $o->ask_from_listW($title, $message, $l, $def || $l->[0]);
+ $o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]);
}
sub ask_many_from_list_ref($$$$;$) {
my ($o, $title, $message, $l, $val) = @_;
-
- $message = ref $message ? $message : [ $message ];
-
- $o->ask_many_from_list_refW($title, $message, $l, $val);
+ $o->ask_many_from_list_refW($title, [ deref($message) ], $l, $val);
}
sub ask_many_from_list($$$$;$) {
my ($o, $title, $message, $l, $def) = @_;
@@ -106,8 +101,7 @@ sub ask_many_from_list($$$$;$) {
sub ask_from_entry {
my ($o, $title, $message, $label, $def, %callback) = @_;
- $message = ref $message ? $message : [ $message ];
- first ($o->ask_from_entries($title, $message, [ $label ], [ $def ], %callback));
+ first ($o->ask_from_entries($title, [ deref($message) ], [ $label ], [ $def ], %callback));
}
sub ask_from_entries($$$$;$%) {
@@ -137,7 +131,9 @@ sub ask_from_entries_ref($$$$;$%) {
return unless @$l;
- $message = ref $message ? $message : [ $message ];
+ $title = [ deref($title) ];
+ $title->[2] ||= _("Cancel") unless $title->[1];
+ $title->[1] ||= _("Ok");
my $val_hash = [ map {
if ((ref $_) eq "SCALAR") {
@@ -148,20 +144,18 @@ sub ask_from_entries_ref($$$$;$%) {
}
} @$val ];
- $o->ask_from_entries_refW($title, $message, $l, $val_hash, %callback)
+ $o->ask_from_entries_refW($title, [ deref($message) ], $l, $val_hash, %callback)
}
sub wait_message($$$;$) {
my ($o, $title, $message, $temp) = @_;
- $message = ref $message ? $message : [ $message ];
-
- my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]);
+ my $w = $o->wait_messageW($title, [ _("Please wait"), deref($message) ]);
push @tempory::objects, $w if $temp;
my $b = before_leaving { $o->wait_message_endW($w) };
#- enable access through set
- common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set');
+ common::add_f4before_leaving(sub { $o->wait_message_nextW([ deref($_[1]) ], $w) }, $b, 'set');
$b;
}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 40b97be7c..7aec4b070 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -74,8 +74,7 @@ sub ask_many_from_list_refW($$$$$) {
sub ask_from_entries_refW {
my ($o, $title, $messages, $l, $val, %hcallback) = @_;
- my ($title_, @okcancel) = ref $title ? @$title : $title;
- my $num_fields = @{$l};
+ my ($title_, @okcancel) = deref($title);
my $ignore = 0; #-to handle recursivity
my $w = my_gtk->new($title_, %$o);
@@ -122,7 +121,7 @@ sub ask_from_entries_refW {
} \@widgets, $val;
- for (my $i = 0; $i < $num_fields; $i++) {
+ for (my $i = 0; $i < @$l; $i++) {
my $ind = $i; #-cos lexical bindings pb !!
my $widget = widget($widgets[$i], $val->[$i]);
my $changed_callback = sub {
@@ -150,7 +149,7 @@ sub ask_from_entries_refW {
if (ref $widget eq "Gtk::Entry") {
$widget->signal_connect(changed => $changed_callback);
my $go_to_next = sub {
- if ($ind == ($num_fields -1)) {
+ if ($ind == $#$l) {
$w->{ok}->grab_focus();
} else {
widget($widgets[$ind+1],$val->[$ind+1])->grab_focus();
@@ -201,20 +200,20 @@ sub ask_from_entries_refW {
sub wait_messageW($$$) {
- my ($o, $title, $message) = @_;
+ my ($o, $title, $messages) = @_;
my $w = my_gtk->new($title, %$o, grab => 1);
- my $W = pop @$message;
+ my $W = pop @$messages;
gtkadd($w->{window},
gtkpack(new Gtk::VBox(0,0),
- @$message,
+ @$messages,
$w->{wait_messageW} = new Gtk::Label($W)));
$w->sync;
$w;
}
sub wait_message_nextW {
- my ($o, $message, $w) = @_;
- $w->{wait_messageW}->set($message);
+ my ($o, $messages, $w) = @_;
+ $w->{wait_messageW}->set(join "\n", @$messages);
$w->sync;
}
sub wait_message_endW {
diff --git a/perl-install/interactive_newt.pm b/perl-install/interactive_newt.pm
index a6ae69d25..63346ed65 100644
--- a/perl-install/interactive_newt.pm
+++ b/perl-install/interactive_newt.pm
@@ -8,218 +8,204 @@ use vars qw(@ISA);
use interactive;
use common qw(:common :functional);
-use Term::Newt;
+use log;
+use Newt::Newt;
my $width = 80;
my $height = 25;
+my @wait_messages;
-my $n = Term::Newt->new;
-$n->init;
-$n->cls;
+sub new() {
+ Newt::Init;
+ Newt::changeColors;
+ Newt::Cls;
+ Newt::SetSuspendCallback;
+ bless {}, $_[0];
+}
+
+sub end { Newt::Finished }
+END { end() }
+
+sub myTextbox {
+ my @l = map { split "\n" } @_;
+ my $mess = Newt::Component::Textbox(1, 0, my $w = max(map { length } @l) + 1, my $h = @l, 1 << 6);
+ $mess->TextboxSetText(join("\n", @_));
+ $mess, $w + 1, $h;
+}
+
+sub separator($$) {
+ my $blank = Newt::Component::Form(\undef, '', 0);
+ $blank->FormSetWidth ($_[0]);
+ $blank->FormSetHeight($_[1]);
+ $blank;
+}
+sub checkval($) { $_[0] && $_[0] ne ' ' ? '*' : ' ' }
sub ask_from_listW {
my ($o, $title_, $messages, $l, $def) = @_;
my ($title, @okcancel) = ref $title_ ? @$title_ : ($title_, _("Ok"), _("Cancel"));
+
my $mesg = join("\n", @$messages);
+ log::l("ask_from_listW: " . (join "|", @$l));
if (@$l == 1) {
- $n->win_message($title, @$l, $mesg);
+ Newt::WinMessage($title, @$l, $mesg);
$l->[0];
} elsif (@$l == 2) {
- $l->[$n->win_choice($title, @$l, $mesg) - 1];
+ $l->[Newt::WinChoice($title, @$l, $mesg) - 1];
} elsif (@$l == 3) {
- $l->[$n->win_ternary($title, @$l, $mesg) - 1];
+ $l->[Newt::WinTernary($title, @$l, $mesg) - 1];
} else {
+ my $special = !@okcancel;
+ if ($special) {
+ $l = [ @$l ];
+ @okcancel = pop @$l;
+ }
my $i; map_index { $i = $::i if $def eq $_ } @$l;
- my ($r, $e) = $n->newtWinMenu($title, $mesg, 40, 5, 5, 8, $l, $i, @okcancel);
+ my ($r, $e) = Newt::WinMenu($title, $mesg, 40, 5, 5, 8, $l, $i, @okcancel);
return if $r > 1;
- $l->[$e];
+ if ($special) {
+ $r ? $okcancel[0] : $l->[$e];
+ } else {
+ $l->[$e];
+ }
}
}
sub ask_many_from_list_refW($$$$$) {
my ($o, $title, $messages, $list, $val) = @_;
- my $w = my_gtk->new('', %$o);
- my @box = map_index {
- $n->newtCheckbox(1, $::i + 1, $_, ${$val->[$::i]} ? '*' : ' ', " *", ${$val->[$::i]});
- } @$list;
+ my $height = min(int @$list, 18);
- my $l = max(22, 2 + max map { length } @$list);
- my $h = max(10, 2 + @$list + @$messages);
+ my $sb = Newt::Component::VerticalScrollbar(-1, -1, $height, 9, 10);
+ my $checklist = $sb->Form('', 0);
+ $checklist->FormSetHeight($height);
+ $checklist->FormSetBackground(9);
+
+ map_index {
+ $checklist->FormAddComponent(
+ Newt::Component::Checkbox(1, $::i + 1, $_, checkval(${$val->[$::i]} ||= ''), " *", ${$val->[$::i]}));
+ } @$list;
- $n->open_window(($width - $l) / 2, ($height - $h) / 2, $l, $h, $title);
- my $form = $n->form(\ (my $ref = 0),'', 0);
+ my $listg = Newt::Grid::HCloseStacked($checklist, $height < @$list ? (separator(1, $height), $sb) : ());
- $n->form_add_components($form, @box,
- $n->button(1, @$list + 3, _("Ok")),
- $n->button(10, @$list + 3, _("Cancel")));
+ my ($buttons, $ok, $cancel) = Newt::Grid::ButtonBar(_("Ok"), _("Cancel"));
- $n->run_form($form);
- $n->form_destroy($form);
+ my $form = Newt::Component::Form(\undef, '', 0);
+ my $window = Newt::Grid::GridBasicWindow(first(myTextbox(@$messages)), $listg, $buttons);
+ $window->GridWrappedWindow($title);
+ $window->GridAddComponentsToForm($form, 1);
+ my $r = $form->RunForm;
+ $form->FormDestroy;
+ Newt::PopWindow;
+
+ $$r == $$cancel and return;
$$_ = $$_ eq "*" foreach @$val;
+ 1;
}
-#sub ask_from_entries_refW {
-# my ($o, $title, $messages, $l, $val, %hcallback) = @_;
-# my ($title_, @okcancel) = ref $title ? @$title : $title;
-# my $num_fields = @{$l};
-# my $ignore = 0; #-to handle recursivity
-#
-# my $w = my_gtk->new($title_, %$o);
-# #-the widgets
-# my @widgets = map {
-# if ($_->{type} eq "list") {
-# my $w = new Gtk::Combo;
-# $w->set_use_arrows_always(1);
-# $w->entry->set_editable(!$_->{not_edit});
-# $w->set_popdown_strings(@{$_->{list}});
-# $w->disable_activate;
-# $_->{val} ||= $_->{list}[0];
-# $w;
-# } elsif ($_->{type} eq "bool") {
-# my $w = Gtk::CheckButton->new($_->{text});
-# $w->set_active(${$_->{val}});
-# my $i = $_; $w->signal_connect(clicked => sub { $ignore or invbool \${$i->{val}} });
-# $w;
-# } else {
-# new Gtk::Entry;
-# }
-# } @{$val};
-# my $ok = $w->create_okcancel(@okcancel);
-#
-# sub widget {
-# my ($w, $ref) = @_;
-# ($ref->{type} eq "list" && @{$ref->{list}}) ? $w->entry : $w
-# }
-# my @updates = mapn {
-# my ($w, $ref) = @_;
-# sub {
-# $ref->{type} eq "bool" and return;
-# ${$ref->{val}} = widget($w, $ref)->get_text;
-# };
-# } \@widgets, $val;
-#
-# my @updates_inv = mapn {
-# my ($w, $ref) = @_;
-# sub {
-# $ref->{type} eq "bool" ?
-# $w->set_active(${$ref->{val}}) :
-# widget($w, $ref)->set_text(${$ref->{val}})
-# };
-# } \@widgets, $val;
-#
-#
-# for (my $i = 0; $i < $num_fields; $i++) {
-# my $ind = $i; #-cos lexical bindings pb !!
-# my $widget = widget($widgets[$i], $val->[$i]);
-# my $changed_callback = sub {
-# return if $ignore; #-handle recursive deadlock
-# &{$updates[$ind]};
-# if ($hcallback{changed}) {
-# &{$hcallback{changed}}($ind);
-# #update all the value
-# $ignore = 1;
-# &$_ foreach @updates_inv;
-# $ignore = 0;
-# };
-# };
-# if ($hcallback{focus_out}) {
-# my $focusout_callback = sub {
-# return if $ignore;
-# &{$hcallback{focus_out}}($ind);
-# #update all the value
-# $ignore = 1;
-# &$_ foreach @updates_inv;
-# $ignore = 0;
-# };
-# $widget->signal_connect(focus_out_event => $focusout_callback);
-# }
-# if (ref $widget eq "Gtk::Entry") {
-# $widget->signal_connect(changed => $changed_callback);
-# my $go_to_next = sub {
-# if ($ind == ($num_fields -1)) {
-# $w->{ok}->grab_focus();
-# } else {
-# widget($widgets[$ind+1],$val->[$ind+1])->grab_focus();
-# }
-# };
-# $widget->signal_connect(activate => $go_to_next);
-# $widget->signal_connect(key_press_event => sub {
-# my ($w, $e) = @_;
-# #-don't know why it works, i believe that
-# #-i must say before &$go_to_next, but with it doen't work HACK!
-# $w->signal_emit_stop("key_press_event") if chr($e->{keyval}) eq "\x8d";
-# });
-# $widget->set_text(${$val->[$i]{val}}) if ${$val->[$i]{val}};
-# $widget->set_visibility(0) if $val->[$i]{hidden};
-# }
-# &{$updates[$i]};
-# }
-#
-# my @entry_list = mapn { [($_[0], $_[1])]} $l, \@widgets;
-#
-# gtkadd($w->{window},
-# gtkpack(
-# create_box_with_title($w, @$messages),
-# create_packtable({}, @entry_list),
-# $ok
-# ));
-# widget($widgets[0],$val->[0])->grab_focus();
-# if ($hcallback{complete}) {
-# my $callback = sub {
-# my ($error, $focus) = &{$hcallback{complete}};
-# #-update all the value
-# $ignore = 1;
-# foreach (@updates_inv) { &{$_};}
-# $ignore = 0;
-# if ($error) {
-# $focus ||= 0;
-# widget($widgets[$focus], $val->[$focus])->grab_focus();
-# } else {
-# return 1;
-# }
-# };
-# #$w->{ok}->signal_connect(clicked => $callback)
-# $w->main($callback);
-# } else {
-# $w->main();
-# }
-#}
-#
-#
-#sub wait_messageW($$$) {
-# my ($o, $title, $message) = @_;
-#
-# my $w = my_gtk->new($title, %$o, grab => 1);
-# my $W = pop @$message;
-# gtkadd($w->{window},
-# gtkpack(new Gtk::VBox(0,0),
-# @$message,
-# $w->{wait_messageW} = new Gtk::Label($W)));
-# $w->sync;
-# $w;
-#}
-#sub wait_message_nextW {
-# my ($o, $message, $w) = @_;
-# $w->{wait_messageW}->set($message);
-# $w->sync;
-#}
-#sub wait_message_endW {
-# my ($o, $w) = @_;
-# $w->destroy;
-#}
-#
-#sub kill {
-# my ($o) = @_;
-# $o->{before_killing} ||= 0;
-# while (@interactive::objects > $o->{before_killing}) {
-# my $w = pop @interactive::objects;
-# $w->destroy;
-# }
-# @my_gtk::grabbed = ();
-# $o->{before_killing} = @interactive::objects;
-#}
+sub ask_from_entries_refW {
+ my ($o, $title, $messages, $l, $val, %hcallback) = @_;
+ my ($title_, @okcancel) = deref($title);
+ my $ignore = 0; #-to handle recursivity
+
+ #-the widgets
+ my @widgets = map {
+ $_->{type} = "entry" if $_->{type} eq "list" && !$_->{not_edit};
+ ${$_->{val}} ||= '';
+ if ($_->{type} eq "list" && $_->{not_edit}) {
+ $_->{val} ||= $_->{list}[0];
+ my $w = Newt::Component::Listbox(-1, -1, 1, 0);
+ $w->ListboxSetWidth(20);
+ map_index { $w->ListboxAddEntry($_, $_) } @{$_->{list}};
+ $w;
+ } elsif ($_->{type} eq "bool") {
+ Newt::Component::Checkbox(-1, -1, $_->{text} || '', checkval(${$_->{val}}), " *", ${$_->{val}});
+ } else {
+ Newt::Component::Entry(-1, -1, '', 20, ($_->{hidden} && 1 << 1) | 1 << 2);
+ }
+ } @$val;
+
+ my @updates = mapn {
+ my ($w, $ref) = @_;
+ sub {
+ ${$ref->{val}} =
+ $ref->{type} eq "bool" ?
+ $w->CheckboxGetValue :
+ $ref->{type} eq "list" ?
+ $w->ListboxGetCurrent :
+ $w->EntryGetValue;
+ };
+ } \@widgets, $val;
+
+ my @updates_inv = mapn {
+ my ($w, $ref) = @_;
+ my $val = ${$ref->{val}};
+ sub {
+ print STDERR "$ref->{type}: ($val)\n";
+ $ref->{type} eq "bool" ?
+ $w->CheckboxSetValue(checkval($val)) :
+ $ref->{type} eq "list" ?
+ $w->ListboxSetCurrentByKey($val) :
+ $w->EntrySet($val, 1);
+ };
+ } \@widgets, $val;
+
+ map { &{$updates_inv[$_]} } 0..$#widgets;
+
+ my $grid = Newt::Grid::CreateGrid(3, int @$l);
+ map_index {
+ $grid->GridSetField(0, $::i, 1, ${Newt::Component::Label(-1, -1, $_)}, 0, 0, 0, 0, 1, 0);
+ $grid->GridSetField(1, $::i, 1, ${$widgets[$::i]}, 0, 0, 0, 0, 1, 0);
+ } @$l;
+
+ my ($buttons, $ok, $cancel) = Newt::Grid::ButtonBar(@okcancel);
+
+ my $form = Newt::Component::Form(\undef, '', 0);
+ my $window = Newt::Grid::GridBasicWindow(first(myTextbox(@$messages)), $grid, $buttons);
+ $window->GridWrappedWindow($title_);
+ $window->GridAddComponentsToForm($form, 1);
+ my $r = $form->RunForm;
+ map { &{$updates[$_]} } 0..$#widgets;
+ $form->FormDestroy;
+ Newt::PopWindow;
+ $$r != $$cancel;
+}
+
+
+sub waitbox($$) {
+ my ($title, $messages) = @_;
+ my ($t, $w, $h) = myTextbox(@$messages);
+ my $f = Newt::Component::Form(\undef, '', 0);
+ Newt::CenteredWindow($w, $h, $title);
+ $f->FormAddComponent($t);
+ $f->DrawForm;
+ Newt::Refresh;
+ $f->FormDestroy;
+ push @wait_messages, $f;
+ $f;
+}
+
+
+sub wait_messageW($$$) {
+ my ($o, $title, $messages) = @_;
+ { form => waitbox($title, $messages), title => $title };
+}
+
+sub wait_message_nextW {
+ my ($o, $messages, $w) = @_;
+ $o->wait_message_endW($w);
+ $o->wait_messageW($w->{title}, $messages);
+}
+sub wait_message_endW {
+ my ($o, $w) = @_;
+ log::l("interactive_newt does not handle none stacked wait-messages") if $w->{form} != pop @wait_messages;
+ Newt::PopWindow;
+}
+
+sub kill {
+}
+
1;
diff --git a/perl-install/interactive_stdio.pm b/perl-install/interactive_stdio.pm
index d99ea990f..e37e71672 100644
--- a/perl-install/interactive_stdio.pm
+++ b/perl-install/interactive_stdio.pm
@@ -9,7 +9,7 @@ use vars qw(@ISA);
use interactive;
use common qw(:common);
-1;
+$| = 1;
sub readln {
my $l = <STDIN>;
@@ -23,9 +23,10 @@ sub check_it {
}
sub ask_from_listW {
- my ($o, $title, $messages, $list, $def) = @_;
- my $i;
+ my ($o, $title_, $messages, $list, $def) = @_;
+ my ($title, @okcancel) = ref $title_ ? @$title_ : ($title_, _("Ok"), _("Cancel"));
print map { "$_\n" } @$messages;
+ my $i;
if (@$list < 10 && sum(map { length $_ } @$list) < 50) {
my @l;
@@ -81,10 +82,15 @@ sub ask_many_from_list_refW {
$val;
}
-
sub wait_messageW {
my ($o, $title, $message) = @_;
- print map { "$_\n" } @$message;
+ print join "\n", @$message;
}
-sub wait_message_nextW { print "$_[1]\n" }
-sub wait_message_endW { print "Done\n" }
+sub wait_message_nextW {
+ my $m = join "\n", @{$_[1]};
+ print "\r$m", ' ' x (60 - length $m);
+}
+sub wait_message_endW { print "\nDone\n" }
+
+1;
+
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index 1e1d1a09f..fc9bf1648 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -24,6 +24,7 @@ my @MBR_signatures = (
[ 'system_commander', 0x1ad, "SYSCMNDRSYS" ],
[ 'dos', 0xa0, "\x25\x03\x4E\x02\xCD\x13" ],
[ 'dos', 0x60, "\xBB\x00\x7C\xB8\x01\x02\x57\xCD\x13\x5F\x73\x0C\x33\xC0\xCD\x13" ], #- nt's
+ [ 'freebsd', 0xC0, "\x00\x30\xE4\xCD\x16\xCD\x19\xBB\x07\x00\xB4" ],
[ 'dummy', 0xAC, "\x0E\xB3\x07\x56\xCD\x10\x5E\xEB" ], #- caldera?
[ 'ranish', 0x100, "\x6A\x10\xB4\x42\x8B\xF4\xCD\x13\x8B\xE5\x73" ],
);
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 0179bf45d..07d04073b 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -476,7 +476,7 @@ sub install($$) {
log::ld("starting installation: ", $nb, " packages, ", $total, " bytes");
- #- !! do not translate these messages, they are used when catched (cf install_steps_graphical)
+ #- !! do not translate these messages, they are used when catched (cf install_steps_gtk)
my $callbackOpen = sub {
my $f = (my $p = $packages{$_[0]})->{file};
print LOG "$f\n";
diff --git a/perl-install/share/compssList b/perl-install/share/compssList
index db546808e..eda20824f 100644
--- a/perl-install/share/compssList
+++ b/perl-install/share/compssList
@@ -7,6 +7,7 @@ AfterStep 65 20 53
AfterStep-APPS 62 18 55
aktion 79 12 15
am-utils 22 0 19
+anacron 85 40 85
anonftp 15 99 13
AnotherLevel 30 0 27
apache 15 99 25
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-05 19:30:45 +0000