summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMaster/install-tl32
-rw-r--r--Master/tlpkg/installer/install-menu-perltk.pl17
-rwxr-xr-xMaster/tlpkg/installer/install-menu-text.pl4
-rw-r--r--Master/tlpkg/installer/install-menu-wizard.pl65
4 files changed, 57 insertions, 61 deletions
diff --git a/Master/install-tl b/Master/install-tl
index fa6116a6620..319eb5a3d7c 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -99,6 +99,14 @@ use strict;
# $install{$packagename} == 1 if it should be installed
my %install;
+#
+# the different modules have to assign a code blob to this global variable
+# which starts the installation.
+# Example: In install-menu-text.pl there is
+# $::run_menu = \&run_menu_text;
+#
+$::run_menu = sub { die "no UI defined." ; };
+
# the default scheme to be installed
my $default_scheme='scheme-full';
@@ -399,8 +407,8 @@ if ($opt_profile eq "") {
# here we could load different menu systems. Currently several things
# are "our" so that the menu implementation can use it. The $tlpdb, the
# %var, and all the @collection*
- # install-menu-*.pl should implement a function run_menu() and should
- # change ONLY stuff in %vars
+ # install-menu-*.pl have to assign a code ref to $::run_menu which is
+ # run, and should change ONLY stuff in %vars
# The allowed keys in %vars should be specified somewhere ...
# the menu implementation should return
# MENU_INSTALL do the installation
@@ -428,7 +436,8 @@ if ($opt_profile eq "") {
tlwarn("Using text mode installer.\n");
require("installer/install-menu-text.pl");
}
- my $ret = run_menu(@runargs);
+
+ my $ret = &{$::run_menu}(@runargs);
if ($ret == $MENU_QUIT) {
do_cleanup(); MISSING
flushlog();
@@ -1455,6 +1464,23 @@ sub do_portable {
}
}
+#
+# some helper fucntion
+sub select_collections {
+ my $varref = shift;
+ foreach (@_) {
+ $varref->{$_} = 1;
+ }
+}
+
+sub deselect_collections {
+ my $varref = shift;
+ foreach (@_) {
+ $varref->{$_} = 0;
+ }
+}
+
+
__END__
=head1 NAME
diff --git a/Master/tlpkg/installer/install-menu-perltk.pl b/Master/tlpkg/installer/install-menu-perltk.pl
index 5786a299097..dcca6100ca2 100644
--- a/Master/tlpkg/installer/install-menu-perltk.pl
+++ b/Master/tlpkg/installer/install-menu-perltk.pl
@@ -223,7 +223,7 @@ my $fmtyesno = ( $vars{'option_fmt'} ? $text{'yes'} : $text{'no'} );
my $srcyesno = ( $vars{'option_src'} ? $text{'yes'} : $text{'no'} );
my $docyesno = ( $vars{'option_doc'} ? $text{'yes'} : $text{'no'} );
-sub run_menu {
+sub run_menu_perltk {
calc_depends();
$mainwindow = Tk::MainWindow->new;
@@ -402,6 +402,7 @@ sub run_menu {
Tk::MainLoop();
return($return);
}
+$::run_menu = \&run_menu_perltk;
sub installation_window {
# create a progress bar window
@@ -923,20 +924,6 @@ sub dump_vars_stdout {
}
}
-sub select_collections {
- my $varref = shift;
- foreach (@_) {
- $varref->{$_} = 1;
- }
-}
-
-sub deselect_collections {
- my $varref = shift;
- foreach (@_) {
- $varref->{$_} = 0;
- }
-}
-
sub toggle_and_set_opt_variable {
my ($varsref, $toggleref) = @_;
$$toggleref = ($$toggleref eq $text{'yes'}) ? $text{'no'} : $text{'yes'};
diff --git a/Master/tlpkg/installer/install-menu-text.pl b/Master/tlpkg/installer/install-menu-text.pl
index d9869d80501..87c99474789 100755
--- a/Master/tlpkg/installer/install-menu-text.pl
+++ b/Master/tlpkg/installer/install-menu-text.pl
@@ -108,14 +108,14 @@ sub prompt {
# The menu loop. A menu is a function. Its return value is a
# reference to another menu or to itself.
-sub run_menu {
+sub run_menu_text {
my $menu=\&main_menu;
while ($RETURN == $MENU_CONTINUE) {
$menu=$menu->();
}
return($RETURN);
}
-
+$::run_menu = \&run_menu_text;
sub binary_menu {
my %command=(
diff --git a/Master/tlpkg/installer/install-menu-wizard.pl b/Master/tlpkg/installer/install-menu-wizard.pl
index 0d6045a6a31..8977f717a7d 100644
--- a/Master/tlpkg/installer/install-menu-wizard.pl
+++ b/Master/tlpkg/installer/install-menu-wizard.pl
@@ -20,7 +20,7 @@
# pack_buttons("-no-config", "cancel", "prev", "next");
# Normally the text of $nxt button is set according to the existence of
# a following screen to either Next or Install, and in the latter case
-# the -command is changed to \&installation_window
+# the -command is changed to \&wizard_installation_window
# Calling with "-no-config" as first argument does inhibit that.
#
# The list of screens can be set using the run_menu(@screens), and
@@ -185,25 +185,25 @@ sub run_screen {
push @::info_hook,
sub {
return unless defined($mw);
- update_status(join(" ",@_));
+ wizard_update_status(join(" ",@_));
$mw->update;
};
push @::warn_hook,
sub {
return unless defined($mw);
- update_status(join(" ",@_));
+ wizard_update_status(join(" ",@_));
$mw->update;
};
-push @::install_packages_hook, \&update_progressbar;
+push @::install_packages_hook, \&wizard_update_progressbar;
push @::install_packages_hook,
sub { $mw->update; $::sww->update; };
-sub update_status {
+sub wizard_update_status {
my ($p) = @_;
$::progressw->insert("end", "$p");
$::progressw->see("end");
}
-sub update_progressbar {
+sub wizard_update_progressbar {
my ($n,$total) = @_;
if (defined($n) && defined($total)) {
$::progress->value(int($n*100/$total));
@@ -323,7 +323,7 @@ sub pack_buttons {
if (!$skip_buttonconfig) {
if (!defined(next_screen($current_screen))) {
$nxt->configure(-text => "Install",
- -command => \&installation_window);
+ -command => \&wizard_installation_window);
} else {
$nxt->configure(-text => "Next >",
-command => sub { run_screen(next_screen()); } );
@@ -340,7 +340,7 @@ sub pack_buttons {
################# WELCOME SCREEN ######################################
-sub run_menu {
+sub run_menu_wizard {
my @args = @_;
if (@args) {
@@ -384,7 +384,7 @@ sub run_menu {
Tk::MainLoop();
return($return);
}
-
+$::run_menu = \&run_menu_wizard;
sub reset_start {
$current_screen = "welcome";
@@ -458,7 +458,16 @@ sub change_systems {
$f2->pack(-padx => "2m", -pady => "2m");
my $f3 = $sw->Frame;
my $okbutton = $f3->Button(-text => $text{'ok'},
- -command => sub { callback_select_systems() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m");
+ -command => sub {
+ if ($vars{"binary_win32"}) {
+ $vars{"collection-wintools"} = 1;
+ } else {
+ $vars{"collection-wintools"} = 0;
+ }
+ calc_depends();
+ update_numbers();
+ $sw->destroy;
+ })->pack(-side => 'left', -padx => "2m", -pady => "2m");
my $cancelbutton = $f3->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
$f3->pack(-expand => 'x');
@@ -466,16 +475,6 @@ sub change_systems {
$sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']);
}
-sub callback_select_systems() {
- if ($vars{"binary_win32"}) {
- $vars{"collection-wintools"} = 1;
- } else {
- $vars{"collection-wintools"} = 0;
- }
- calc_depends();
- update_numbers();
-}
-
############## SCHEME SCREEN #####################################
@@ -584,7 +583,7 @@ sub ask_path {
@::info_hook = ();
@::install_packages_hook = ();
require("installer/install-menu-perltk.pl");
- $return = run_menu();
+ $return = &{$::run_menu}();
});
$pa->pack(-anchor => "w");
$cb->pack(-anchor => "w");
@@ -713,14 +712,14 @@ sub change_stdcoll {
-command => sub { deselect_collections(\%lvars, @collections_std) })->pack(-side => 'right', -padx => "2m", -pady => "2m");
$fc->pack(-expand => 'x', -padx => "2m", -pady => "2m");
my $okbutton = $fc->Button(-text => $text{'ok'},
- -command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m");
+ -command => sub { %vars = %lvars; wizard_callback_select_collection() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m");
my $cancelbutton = $fc->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
$sw->bind('<Return>' => [ $okbutton, 'Invoke']);
$sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']);
}
-sub callback_select_collection {
+sub wizard_callback_select_collection {
calc_depends();
update_numbers();
}
@@ -811,7 +810,7 @@ sub change_langcoll {
-command => sub { deselect_collections(\%lvars, @collections_lang_doc) })->pack(-side => 'left', -padx => "2m", -pady => "2m");
my $f2 = $sw->Frame; $f2->pack(-expand => 'x');
my $okbutton = $f2->Button(-text => $text{'ok'},
- -command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m");
+ -command => sub { %vars = %lvars; wizard_callback_select_collection() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m");
my $cancelbutton = $f2->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
$sw->bind('<Return>' => [ $okbutton, 'Invoke']);
@@ -839,7 +838,7 @@ sub ask_go {
$mw->update;
}
-sub installation_window {
+sub wizard_installation_window {
# create a progress bar window
$::sww = $mw->Toplevel(-title => "installation process",
-width => 400);
@@ -892,22 +891,6 @@ sub installation_window {
-command => sub { $mw->destroy; });
}
-################### HELPER FUNCTIONS ###########################
-
-sub select_collections {
- my $varref = shift;
- foreach (@_) {
- $varref->{$_} = 1;
- }
-}
-
-sub deselect_collections {
- my $varref = shift;
- foreach (@_) {
- $varref->{$_} = 0;
- }
-}
-
################### END OF MODULE RETURN 1 FOR REQUIRE ###########
1;