diff options
Diffstat (limited to 'Master/tlpkg/installer/install-menu-wizard.pl')
-rw-r--r-- | Master/tlpkg/installer/install-menu-wizard.pl | 226 |
1 files changed, 221 insertions, 5 deletions
diff --git a/Master/tlpkg/installer/install-menu-wizard.pl b/Master/tlpkg/installer/install-menu-wizard.pl index 7411792a331..d5b8fe393de 100644 --- a/Master/tlpkg/installer/install-menu-wizard.pl +++ b/Master/tlpkg/installer/install-menu-wizard.pl @@ -33,6 +33,7 @@ if (win32()) { our %vars; our $tlpdb; our $texlive_release; +our @media_available; our $MENU_INSTALL = 0; our $MENU_ABORT = 1; @@ -43,6 +44,7 @@ our $MENU_ALREADYDONE = 3; my $return = $MENU_INSTALL; require Tk; +require Tk::BrowseEntry; require Tk::Dialog; require Tk::DialogBox; require Tk::PNG; @@ -71,6 +73,8 @@ my $ftitle; my $counter; my $lineskip; +$::init_remote_needed = 0; + my $LEFT = 130; my $RIGHT = 50; my $TOP = 50; @@ -118,6 +122,7 @@ sub setup_hooks_wizard { sub wizard_update_status { my ($p) = @_; + return unless defined($::progressw); $::progressw->insert("end", "$p"); $::progressw->see("end"); } @@ -135,9 +140,6 @@ sub run_menu_wizard { $mw->protocol('WM_DELETE_WINDOW' => \&menu_abort); setup_hooks_wizard(); - $dest = $vars{'TEXDIR'}; - $dest_display = native_slashify($dest); - my $img = $mw->Photo(-format => 'png', -file => "$::installerdir/tlpkg/installer/texlive.png"); $mw->Label(-image => $img, -background => "#0078b8")->place(-x => 0, -y => 0); @@ -191,19 +193,233 @@ sub reset_start { ? __("Or use install-tl-advanced.bat") : __("Or use the argument --gui expert to install-tl.") ), -justify => "left"); - $inf->place(-x => 0, -y => 100); + $inf->place(-x => 0, -y => 50); + + # by default, if local media is present, we don't show this option + # unless the command line option -select_repository is given + my $adjust_mirror = 0; + if ($#media_available == -1 || $::opt_select_repository) { + my $mirror_selector = $fmain->Checkbutton( + -text => __("Change default repository"), + -variable => \$adjust_mirror + ); + $mirror_selector->place(-x => 0, -y => 250); + } - $nxt->configure(-text => __("Next >") , -command => \&ask_path ); + $nxt->configure(-text => __("Next >") , + -command => sub { + if ($adjust_mirror) { + ask_mirror(); + } else { + $::init_remote_needed = 1; + load_remote_screen(); + } + }); $nxt->configure(-state => "normal"); } +################## MIRROR SCREEN ################################ + +sub ask_mirror { + for ($fmain->children) { + $_->destroy; + } + $counter->configure(-text => "1-1/5"); + + my @mirror_list; + my @netlst; + my @loclst; + if ($#media_available >= 0) { + for my $l (@media_available) { + my ($a, $b) = split ('#', $l); + if ($a eq 'local_compressed' || $a eq 'local_uncompressed') { + push @loclst, " $b"; + } elsif ($a eq 'NET') { + push @netlst, " cmd line repository: $b"; + } else { + tlwarn("Unknown media $l\n"); + } + } + if ($#loclst >= 0) { + push @mirror_list, "LOCAL REPOSITORIES"; + push @mirror_list, @loclst; + } + } + push @mirror_list, "NETWORK REPOSITORIES"; + push @mirror_list, " Default repository: http://mirror.ctan.org"; + push @mirror_list, @netlst; + push @mirror_list, TeXLive::TLUtils::create_mirror_list(); + + my $mirror_entry; + + $fmain->Label(-text => "Select repository for installation:")->place( + -x => 0, -y => 0); + $fmain->Label(-text => __("Mirror:"))->place(-x => 0, -y => 50); + $fmain->BrowseEntry(-state => 'readonly', + -listheight => 12, + -listwidth => 400, + -width => 35, + -autolistwidth => 1, + -choices => \@mirror_list, + -browsecmd => + sub { + if ($mirror_entry !~ m/^ /) { + $mirror_entry = ""; + } else { + $mirror_entry = TeXLive::TLUtils::extract_mirror_entry($mirror_entry); + } + }, + -variable => \$mirror_entry)->place(-x => 150, -y => 50); + + $prv->configure(-text => __('< Back'), -command => \&reset_start ); + $nxt->configure(-text => __('Next >'), + -command => + sub { $::init_remote_needed = 1; load_remote_screen($mirror_entry); }); + + my $rb = $MWIDTH - $RIGHT; + $rb -= $nxt->width; + $rb -= 30; + + $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); +} + +sub ask_mirror_hierarchical { + for ($fmain->children) { + $_->destroy; + } + $counter->configure(-text => "1-1/5"); + + our $mirrors; + require("installer/mirrors.pl"); + + my @continents = sort keys %$mirrors; + my @countries; + my @mirrors; + $fmain->Label(-text => "Select mirror for installation:")->place( + -x => 0, -y => 0); + my $continent = ""; + my $country = ""; + my $mirror = ""; + my $cbrowser; + my $mbrowser; + $fmain->Label(-text => __("Continent"))->place(-x => 0, -y => 50); + $fmain->BrowseEntry(-state => 'readonly', + -listheight => $#continents + 1, -choices => \@continents, + -variable => \$continent, + -browsecmd => + sub { + $cbrowser->delete(0,"end"); + @countries = sort keys %{$mirrors->{$continent}}; + for my $c (@countries) { + $cbrowser->insert("end", $c); + } + $mirror = ""; + $country = ""; + })->place(-x => 150, -y => 50); + $fmain->Label(-text => __("Countries"))->place(-x => 0, -y => 100); + $cbrowser = $fmain->BrowseEntry(-state => 'readonly', + -listheight => 5, -choices => \@countries, + -variable => \$country, + -browsecmd => + sub { + $mbrowser->delete(0,"end"); + @mirrors = sort keys %{$mirrors->{$continent}{$country}}; + for my $m (@mirrors) { + $mbrowser->insert("end", $m); + } + # always select the first mirror in the list + if ($#mirrors >= 0) { + $mirror = $mirrors[0]; + } else { + $mirror = ""; + } + })->place(-x => 150, -y => 100); + $fmain->Label(-text => __("Mirrors"))->place(-x => 0, -y => 150); + $mbrowser = $fmain->BrowseEntry(-state => 'readonly', + -listheight => 5, -choices => \@mirrors, + -variable => \$mirror,)->place(-x => 150, -y => 150); + + $prv->configure(-text => __('< Back'), -command => \&reset_start ); + $nxt->configure(-text => __('Next >'), + -command => + sub { + if (!defined($continent) || !defined($country) || !defined($mirror) || + $continent eq "" || $country eq "" || $mirror eq "") { + # do nothing, we just use the default mirror + $::init_remote_needed = 1; + load_remote_screen(); + } else { + my %m = %{$mirrors->{$continent}->{$country}->{$mirror}->{'protocols_path'}}; + my $mfull; + $mfull = "ftp://" . $m{'ftp'} if defined($m{'ftp'}); + $mfull = "http://" . $m{'http'} if defined($m{'http'}); + # remove terminal / if present + $mfull =~ s!/$!!; + $mfull .= "/" . $TeXLive::TLConfig::TeXLiveServerPath; + # set the selected location before going on! + $::init_remote_needed = 1; + load_remote_screen($mfull); + } + }); + + my $rb = $MWIDTH - $RIGHT; + $rb -= $nxt->width; + $rb -= 30; + + $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); +} + + ################## PATH SCREEN ################################ +sub load_remote_screen { + my $remote_path = shift; + for ($fmain->children) { + $_->destroy; + } + $counter->configure(-text => "1-2/5"); + + if ($::init_remote_needed) { + my $labela = $fmain->Label(-text => __('Please wait while the repository database is loaded.'))->place(-x => 0, -y => 50); + my $labelb = $fmain->Label(-text => __('This will take some time!'))->place(-x => 0, -y => 150); + $prv->placeForget; + $can->placeForget; + $nxt->configure(-text => __('Cancel'), + -command => sub { $return = $MENU_ABORT; $mw->destroy; }); + $mw->update; + only_load_remote($remote_path); + if (!do_version_agree()) { + $labela->configure(-text => __('The TeX Live versions of the local installation +and the repository being accessed are not compatible: + local: %s +repository: %s', $TeXLive::TLConfig::ReleaseYear, $texlive_release)); + $labelb->configure(-text => __('Please go back and select a different mirror.')); + $prv->configure(-text => __('< Back'), -command => \&reset_start ); + } else { + final_remote_init($remote_path); + ask_path(); + } + } else { + ask_path(); + } + + my $rb = $MWIDTH - $RIGHT; + $rb -= $nxt->width; + $rb -= 30; + + $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); +} + sub ask_path { for ($fmain->children) { $_->destroy; } + $counter->configure(-text => "2/5"); + + $dest = $vars{'TEXDIR'}; + $dest_display = native_slashify($dest); + my $lab = $fmain->Label(-text => __('Destination folder:')); my $val = $fmain->Label(-textvar => \$dest_display); my $but = $fmain->Button(-text => __("Change"), -command => \&change_path, |