diff options
-rwxr-xr-x | Master/install-tl | 32 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-perltk.pl | 17 | ||||
-rwxr-xr-x | Master/tlpkg/installer/install-menu-text.pl | 4 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-wizard.pl | 65 |
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; |