From 8403bdd44f7afb2d9b199f310f21f7d757d4d03f Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Tue, 13 Sep 2011 01:18:50 +0000 Subject: support selecting a mirror in all the installers git-svn-id: svn://tug.org/texlive/trunk@23929 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl | 313 +++++++++++++++----------- Master/tlpkg/installer/install-menu-perltk.pl | 182 ++++++++++++--- Master/tlpkg/installer/install-menu-text.pl | 103 +++++++++ Master/tlpkg/installer/install-menu-wizard.pl | 226 ++++++++++++++++++- 4 files changed, 666 insertions(+), 158 deletions(-) diff --git a/Master/install-tl b/Master/install-tl index 19602586cd3..05b239b7d5d 100755 --- a/Master/install-tl +++ b/Master/install-tl @@ -163,6 +163,7 @@ my $opt_version = 0; my $opt_force_arch; my $opt_persistent_downloads = 1; my $opt_allow_ftp = 0; +$::opt_select_repository = 0; # show all options even those not relevant for that arch $::opt_all_options = 0; @@ -217,6 +218,7 @@ GetOptions( "scheme=s" => \$opt_scheme, "all-options" => \$::opt_all_options, "persistent-downloads!" => \$opt_persistent_downloads, + "select-repository" => \$::opt_select_repository, "version" => \$opt_version, "help|?" => \$opt_help) or pod2usage(1); @@ -373,142 +375,44 @@ if (!$opt_custom_bin && (platform() eq "i386-cygwin")) { } } -if (!setup_programs ("$::installerdir/tlpkg/installer", "$::_platform_")) { - tldie("$0: Goodbye.\n"); -} - -# determine where we will find the distribution to install from. -# -$location = $opt_location; -$location || ($location = "$::installerdir"); -if ($location =~ m!^(ctan$|(http|ftp)://)!i) { - $location =~ s,/(tlpkg|archive)?/*$,,; # remove any trailing tlpkg or / - if ($location =~ m/^ctan$/i) { - $location = TeXLive::TLUtils::give_ctan_mirror(); - } elsif ($location =~ m/^$TeXLiveServerURL/) { - my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); - $location =~ s,^($TeXLiveServerURL|ctan$),$mirrorbase,; - } - $TeXLiveURL = $location; - $media = 'NET'; - @media_available = qw/NET/; -} else { - # remove leading file:/+ part - $location =~ s!^file://*!/!i; - $location = abs_path($location); +# determine which media are available, don't put NET here, it is +# assumed to be available at any time +{ + # check the installer dir for what is present + my $tmp = $::installerdir; + $tmp = abs_path($tmp); # remove trailing \ or / (e.g. root of dvd drive on w32) - $location =~ s,[\\\/]$,,; - if (-d "$location/$Archive") { - push @media_available, 'local_compressed'; + $tmp =~ s,[\\\/]$,,; + if (-d "$tmp/$Archive") { + push @media_available, "local_compressed#$tmp"; } - - if (-d "$location/texmf/web2c") { - push @media_available, 'local_uncompressed'; + if (-d "$tmp/texmf/web2c") { + push @media_available, "local_uncompressed#$tmp"; } +} - if (member('local_compressed', @media_available)) { - $media = 'local_compressed'; - # for in_place option we want local_uncompressed media - $media = 'local_uncompressed' if $opt_in_place && - member('local_uncompressed', @media_available); - } elsif (member('local_uncompressed', @media_available)) { - $media = 'local_uncompressed'; +# check command line arguments if given +if ($opt_location) { + my $tmp = $opt_location; + if ($tmp =~ m!^(http|ftp)://!i) { + push @media_available, "NET#$tmp"; } else { - if ($opt_location) { - # user gave a --location but nothing can be found there, so die - die "$0: cannot find installation source at $opt_location.\n"; + # remove leading file:/+ part + $tmp =~ s!^file://*!/!i; + $tmp = abs_path($tmp); + # remove trailing \ or / (e.g. root of dvd drive on w32) + $tmp =~ s,[\\\/]$,,; + if (-d "$tmp/$Archive") { + push @media_available, "local_compressed#$tmp"; + } + if (-d "$tmp/texmf/web2c") { + push @media_available, "local_uncompressed#$tmp"; } - # no --location given, but NET installation - $TeXLiveURL = $location = TeXLive::TLUtils::give_ctan_mirror(); - $media = 'NET'; - } -} -info("Installing TeX Live $TeXLive::TLConfig::ReleaseYear from: $location\n"); - -info("Platform: ", platform(), " => \'", platform_desc(platform), "\'\n"); -if ($opt_custom_bin) { - if (-d $opt_custom_bin && (-r "$opt_custom_bin/kpsewhich" - || -r "$opt_custom_bin/kpsewhich.exe")) { - info("Platform overridden, binaries taken from $opt_custom_bin\n" - . "and will be installed into .../bin/custom.\n"); - } else { - tldie("$opt_custom_bin: Argument to -custom-bin must be a directory " - . "with TeX Live binaries.\n"); } } -if ($media eq "local_uncompressed") { - info("Distribution: live (uncompressed)\n"); -} elsif ($media eq "local_compressed") { - info("Distribution: inst (compressed)\n"); -} elsif ($media eq "NET") { - info("Distribution: net (downloading)\n"); - info("Using URL: $TeXLiveURL\n"); - TeXLive::TLUtils::setup_persistent_downloads() if $opt_persistent_downloads; -} else { - info("Distribution: $media\n"); -} -info("Directory for temporary files: $system_tmpdir\n"); - -if ($opt_in_place and ($media ne "local_uncompressed")) { - print "TeX Live not local or not decompressed; 'in_place' option not applicable\n"; - $opt_in_place = 0; -} elsif ($opt_in_place and (!TeXLive::TLUtils::texdir_check($::installerdir))) { - print "Installer dir not writable; 'in_place' option not applicable\n"; - $opt_in_place = 0; -} -$vars{'in_place'} = $opt_in_place; -$opt_scheme = "" if $opt_in_place; -$vars{'portable'} = $opt_portable; - -load_tlpdb(); - -log("Installer revision: $::installerrevision\n"); -log("Database revision: " . $tlpdb->config_revision . "\n"); - -# correctly set the splitting support -# for local_uncompressed we always support splitting -if (($media eq "NET") || ($media eq "local_compressed")) { - $vars{'src_splitting_supported'} = $tlpdb->config_src_container; - $vars{'doc_splitting_supported'} = $tlpdb->config_doc_container; -} -$texlive_release = $tlpdb->config_release; -if ($media eq "local_uncompressed") { - # existing installation may not have 00texlive.config metapackage - # so use TLConfig to establish what release we have - $texlive_release ||= $TeXLive::TLConfig::ReleaseYear; -} - -# if the release from the remote TLPDB does not agree with the -# TLConfig::ReleaseYear in the first 4 places break out here. -# Why only the first four places: some optional network distributions -# might use -# release/2009-foobar -if ($media eq "NET" - && $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { - die <get_package($opt_scheme); - if (defined($scheme)) { - select_scheme($opt_scheme); # select it - } else { - tlwarn("Scheme $opt_scheme not defined, ignoring it.\n"); - } +if (!setup_programs ("$::installerdir/tlpkg/installer", "$::_platform_")) { + tldie("$0: Goodbye.\n"); } @@ -622,6 +526,153 @@ exit(0); # ################################################################### +# +# SETUP OF REMOTE STUFF +# +# this is now a sub since it is called from the ui plugins on demand +# this allows selecting a mirror first and then continuing + +sub only_load_remote { + my $selected_location = shift; + + # determine where we will find the distribution to install from. + # + $location = $opt_location; + $location = $selected_location if defined($selected_location); + $location || ($location = "$::installerdir"); + if ($location =~ m!^(ctan$|(http|ftp)://)!i) { + $location =~ s,/(tlpkg|archive)?/*$,,; # remove any trailing tlpkg or / + if ($location =~ m/^ctan$/i) { + $location = TeXLive::TLUtils::give_ctan_mirror(); + } elsif ($location =~ m/^$TeXLiveServerURL/) { + my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); + $location =~ s,^($TeXLiveServerURL|ctan$),$mirrorbase,; + } + $TeXLiveURL = $location; + $media = 'NET'; + } else { + if (scalar grep($_ =~ m/^local_compressed/, @media_available)) { + $media = 'local_compressed'; + # for in_place option we want local_uncompressed media + $media = 'local_uncompressed' if $opt_in_place && + member('local_uncompressed', @media_available); + } elsif (scalar grep($_ =~ m/^local_uncompressed/, @media_available)) { + $media = 'local_uncompressed'; + } else { + if ($opt_location) { + # user gave a --location but nothing can be found there, so die + die "$0: cannot find installation source at $opt_location.\n"; + } + # no --location given, but NET installation + $TeXLiveURL = $location = TeXLive::TLUtils::give_ctan_mirror(); + $media = 'NET'; + } + } + load_tlpdb(); +} + + +sub do_remote_init { + only_load_remote(@_); + if (!do_version_agree()) { + TeXLive::TLUtils::tldie <config_release; + if ($media eq "local_uncompressed") { + # existing installation may not have 00texlive.config metapackage + # so use TLConfig to establish what release we have + $texlive_release ||= $TeXLive::TLConfig::ReleaseYear; + } + + # if the release from the remote TLPDB does not agree with the + # TLConfig::ReleaseYear in the first 4 places break out here. + # Why only the first four places: some optional network distributions + # might use + # release/2009-foobar + if ($media eq "NET" + && $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { + return 0; + } else { + return 1; + } +} + +sub final_remote_init { + info("Installing TeX Live $TeXLive::TLConfig::ReleaseYear from: $location\n"); + + info("Platform: ", platform(), " => \'", platform_desc(platform), "\'\n"); + if ($opt_custom_bin) { + if (-d $opt_custom_bin && (-r "$opt_custom_bin/kpsewhich" + || -r "$opt_custom_bin/kpsewhich.exe")) { + info("Platform overridden, binaries taken from $opt_custom_bin\n" + . "and will be installed into .../bin/custom.\n"); + } else { + tldie("$opt_custom_bin: Argument to -custom-bin must be a directory " + . "with TeX Live binaries.\n"); + } + } + if ($media eq "local_uncompressed") { + info("Distribution: live (uncompressed)\n"); + } elsif ($media eq "local_compressed") { + info("Distribution: inst (compressed)\n"); + } elsif ($media eq "NET") { + info("Distribution: net (downloading)\n"); + info("Using URL: $TeXLiveURL\n"); + TeXLive::TLUtils::setup_persistent_downloads() if $opt_persistent_downloads; + } else { + info("Distribution: $media\n"); + } + info("Directory for temporary files: $system_tmpdir\n"); + + if ($opt_in_place and ($media ne "local_uncompressed")) { + print "TeX Live not local or not decompressed; 'in_place' option not applicable\n"; + $opt_in_place = 0; + } elsif ($opt_in_place and (!TeXLive::TLUtils::texdir_check($::installerdir))) { + print "Installer dir not writable; 'in_place' option not applicable\n"; + $opt_in_place = 0; + } + $vars{'in_place'} = $opt_in_place; + $opt_scheme = "" if $opt_in_place; + $vars{'portable'} = $opt_portable; + + log("Installer revision: $::installerrevision\n"); + log("Database revision: " . $tlpdb->config_revision . "\n"); + + # correctly set the splitting support + # for local_uncompressed we always support splitting + if (($media eq "NET") || ($media eq "local_compressed")) { + $vars{'src_splitting_supported'} = $tlpdb->config_src_container; + $vars{'doc_splitting_supported'} = $tlpdb->config_doc_container; + } + set_platforms_supported(); + set_texlive_default_dirs(); + set_install_platform(); + initialize_collections(); + + # initialize the scheme from the command line value, if given. + if ($opt_scheme) { + # add the scheme- prefix if they didn't give it. + $opt_scheme = "scheme-$opt_scheme" if $opt_scheme !~ /^scheme-/; + my $scheme = $tlpdb->get_package($opt_scheme); + if (defined($scheme)) { + select_scheme($opt_scheme); # select it + } else { + tlwarn("Scheme $opt_scheme not defined, ignoring it.\n"); + } + } +} + + sub do_installation { install_warnlines_hook(); if (win32()) { @@ -2076,6 +2127,14 @@ will be adjusted accordingly. For backward compatibility and convenience, C<--location> and C<--repo> are accepted as aliases for this option. +=item B<-select-repository> + +In case the automatic mirror selection does not work out well, giving this +option allows to select a mirror from the current list of CTAN mirrors. +This option is supported in all installer modes (text, wizard, perltk) +and will also offer to install from local media if found, and from +a repository specified on the command line (see above). + =item B<-all-options> Normally options not regarding the current platform are not shown. diff --git a/Master/tlpkg/installer/install-menu-perltk.pl b/Master/tlpkg/installer/install-menu-perltk.pl index 084a10f6b8f..d76e05f719b 100644 --- a/Master/tlpkg/installer/install-menu-perltk.pl +++ b/Master/tlpkg/installer/install-menu-perltk.pl @@ -39,6 +39,7 @@ our @collections_std; our @collections_lang; our @collections_lang_doc; our $texlive_release; +our @media_available; our $MENU_INSTALL = 0; our $MENU_ABORT = 1; @@ -61,6 +62,19 @@ $::letterdesc[1] = __('letter'); my $mw; my $subframe; my $mainwindow; +my $bin_toggle_button; +my $scheme_toggle_button; +my $collection_toggle_button; +my $langcoll_toggle_button; +my $portable_toggle_button; +my $texdir_toggle_button; +my $paper_toggle_button; +my $write_eighteen_toggle_button; +my $format_toggle_button; +my $doc_files_toggle_button; +my $src_files_toggle_button; +my $texworks_toggle_button; +my $load_remote_button; my $bintextbutton; my $schemebutton; my $tmflocalbutton; @@ -82,17 +96,17 @@ my $optletterstate; my $optfmtstate; my $optsrcstate; my $optdocstate; -my $portableyesno = ( $vars{'portable'} ? __("Yes") : __("No") ); -my $letteryesno = $::letterdesc[$vars{'option_letter'}]; -my $fmtyesno = ( $vars{'option_fmt'} ? __("Yes") : __("No") ); -my $srcyesno = ( $vars{'option_src'} ? __("Yes") : __("No") ); -my $deskintyesno = ( $vars{'option_desktop_integration'} ? __("Yes") : __("No") ); -my $pathadjyesno = ( $vars{'option_path'} ? __("Yes") : __("No") ); -my $fileassocyesno = $::fileassocdesc[$vars{'option_file_assocs'}]; -my $editoryesno = ( $vars{'collection-texworks'} ? __("Yes") : __("No") ); -my $adminallyesno = ( $vars{'option_w32_multi_user'} ? __("Yes") : __("No") ); -my $docyesno = ( $vars{'option_doc'} ? __("Yes") : __("No") ); -my $restrictedyesno = ( $vars{'option_write18_restricted'} ? __("Yes") : __("No") ); +my $portableyesno; +my $letteryesno; +my $fmtyesno; +my $srcyesno; +my $deskintyesno; +my $pathadjyesno; +my $fileassocyesno; +my $editoryesno; +my $adminallyesno; +my $docyesno; +my $restrictedyesno; $::run_menu = \&run_menu_perltk; @@ -101,6 +115,19 @@ $::run_menu = \&run_menu_perltk; # From here on only function definitions # ################################################################## +sub setup_perltk_local_vars { + $portableyesno = ( $vars{'portable'} ? __("Yes") : __("No") ); + $letteryesno = $::letterdesc[$vars{'option_letter'}]; + $fmtyesno = ( $vars{'option_fmt'} ? __("Yes") : __("No") ); + $srcyesno = ( $vars{'option_src'} ? __("Yes") : __("No") ); + $deskintyesno = ( $vars{'option_desktop_integration'} ? __("Yes") : __("No") ); + $pathadjyesno = ( $vars{'option_path'} ? __("Yes") : __("No") ); + $fileassocyesno = $::fileassocdesc[$vars{'option_file_assocs'}]; + $editoryesno = ( $vars{'collection-texworks'} ? __("Yes") : __("No") ); + $adminallyesno = ( $vars{'option_w32_multi_user'} ? __("Yes") : __("No") ); + $docyesno = ( $vars{'option_doc'} ? __("Yes") : __("No") ); + $restrictedyesno = ( $vars{'option_write18_restricted'} ? __("Yes") : __("No") ); +} sub menu_abort { $return = $MENU_ABORT; @@ -146,9 +173,42 @@ sub update_progressbar { } } +sub disable_buttons { + change_button_state('disabled'); +} +sub enable_buttons { + change_button_state('normal'); +} + +sub change_button_state { + my $what = shift; + $tmflocalbutton->configure(-state => $what); + $tmfsysvarbutton->configure(-state => $what); + $tmfsysconfigbutton->configure(-state => $what); + $tmfhomebutton->configure(-state => $what); + $bin_toggle_button->configure(-state => $what); + $scheme_toggle_button->configure(-state => $what); + $collection_toggle_button->configure(-state => $what); + $langcoll_toggle_button->configure(-state => $what); + $portable_toggle_button->configure(-state => $what); + $texdir_toggle_button->configure(-state => $what); + $texdir_toggle_button->configure(-state => $what); + $paper_toggle_button->configure(-state => $what); + $write_eighteen_toggle_button->configure(-state => $what); + $format_toggle_button->configure(-state => $what); + $pathbutton->configure(-state => $what); + $doc_files_toggle_button->configure(-state => $what) if defined($doc_files_toggle_button); + $src_files_toggle_button->configure(-state => $what) if defined($src_files_toggle_button); + $texworks_toggle_button->configure(-state => $what) if defined($texworks_toggle_button); +} sub run_menu_perltk { - calc_depends(); + if ($::opt_select_repository) { + } else { + do_remote_init(); + setup_perltk_local_vars(); + calc_depends(); + } $mainwindow = Tk::MainWindow->new; $mainwindow->protocol('WM_DELETE_WINDOW' => \&menu_abort); setup_hooks_perltk(); @@ -176,6 +236,71 @@ sub run_menu_perltk { my $row = 1; $fr->Label(-text => __("TeX Live %s Installation", $TeXLive::TLConfig::ReleaseYear))->grid(-row => $row, -column => 1, -columnspan => 3); + if ($::opt_select_repository) { + $row++; + 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; + $fr->Label(-text => __('Select repository'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); + $fr->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)->grid(-row => $row, -column => 2, -sticky => 'w'); + $load_remote_button = $fr->Button(-text => __("Load"), + -command => sub { + $::init_remote_needed = 1; + my $mfull = $mirror_entry; + only_load_remote($mfull); + if (!do_version_agree()) { + $fr->Dialog(-title => __("Warning"), + -text => __('The TeX Live versions of the local installation and the repository being accessed are not compatible: + local: %s + repository: %s +Please select a different mirror.', $TeXLive::TLConfig::ReleaseYear, $texlive_release), + -buttons => [ __("Ok") ])->Show; + $mirror_entry = ""; + } else { + $load_remote_button->configure(-state => 'disable'); + final_remote_init($mfull); + setup_perltk_local_vars(); + calc_depends(); + menu_update_texts(); + enable_buttons(); + } + })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + } if (!$vars{'in_place'}) { $row++; @@ -187,7 +312,7 @@ sub run_menu_perltk { $fr->Label(-text => __('Binary system(s)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $bintextbutton = $fr->Label(-anchor => 'w'); $bintextbutton->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_select_binsystems(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $bin_toggle_button = $fr->Button(-text => __("Change"), -command => sub { menu_select_binsystems(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } $row++; @@ -196,7 +321,7 @@ sub run_menu_perltk { $fr->Label(-text => __('Selected scheme'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $schemebutton = $fr->Label(-anchor => 'w'); $schemebutton->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_select_scheme(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $scheme_toggle_button = $fr->Button(-text => __("Change"), -command => sub { menu_select_scheme(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; @@ -206,13 +331,13 @@ sub run_menu_perltk { $row++; # standard collection line $fr->Label(-text => __('Standard collections'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Button(-text => __("Change"), -command => sub { menu_select_standard_collections(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $collection_toggle_button = $fr->Button(-text => __("Change"), -command => sub { menu_select_standard_collections(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; # lang collection line $fr->Label(-text => __('Language collections'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $langcoltext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button( -text => __("Change"), -command => sub { menu_select_lang_collections(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $langcoll_toggle_button = $fr->Button( -text => __("Change"), -command => sub { menu_select_lang_collections(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; $collectionstext = $fr->Label(); @@ -226,7 +351,7 @@ sub run_menu_perltk { $row++; $fr->Label(-text => __('Portable setup'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$portableyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_portable(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $portable_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_portable(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; # texdir line @@ -234,9 +359,9 @@ sub run_menu_perltk { $texdirtext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); if (!$vars{'in_place'}) { if ($::alternative_selector) { - $fr->Button(-text => __("Change"), -command => sub { menu_edit_texdir("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $texdir_toggle_button = $fr->Button(-text => __("Change"), -command => sub { menu_edit_texdir("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } else { - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $texdir_toggle_button = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } } @@ -283,30 +408,30 @@ sub run_menu_perltk { # optpaper $fr->Label(-text => __('Default paper size'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$letteryesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_letter'}, \$letteryesno, \@::letterdesc); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $paper_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_letter'}, \$letteryesno, \@::letterdesc); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; $fr->Label(-text => __('Allow execution of restricted list of programs via \write18'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$restrictedyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_write18_restricted'}, \$restrictedyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $write_eighteen_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_write18_restricted'}, \$restrictedyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; $fr->Label(-text => __('Create all format files'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$fmtyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_fmt'}, \$fmtyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $format_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_fmt'}, \$fmtyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); if ($vars{'doc_splitting_supported'} and !$vars{'in_place'}) { $row++; $fr->Label(-text => __('Install font/macro doc tree'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$docyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_doc'}, \$docyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $doc_files_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_doc'}, \$docyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } if ($vars{'src_splitting_supported'} and !$vars{'in_place'}) { $row++; $fr->Label(-text => __('Install font/macro source tree'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$srcyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_src'}, \$srcyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $src_files_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_src'}, \$srcyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } $row++; @@ -346,9 +471,10 @@ sub run_menu_perltk { $fr->Label(-text => __('Install TeXworks front end'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$editoryesno)->grid(-row => $row, -column => 2, -padx => "2m"); if (!$vars{'in_place'}) { - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'collection-texworks'}, \$editoryesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $texworks_toggle_button = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'collection-texworks'}, \$editoryesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } } + if ($vars{'portable'}) { for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { $b->configure(-state => 'disabled') if $b; @@ -376,7 +502,11 @@ sub run_menu_perltk { # })->pack(-side => 'right', -padx => "2m", -pady => "2m"); $row++; $f3->grid(-row => $row, -column => 1, -columnspan => 3); - menu_update_texts(); + if (!$::opt_select_repository) { + menu_update_texts(); + } else { + disable_buttons(); + } $fr->gridColumnconfigure(2, -minsize => 300); $mw->pack(-expand => 1, -fill => "both"); $mw->update; diff --git a/Master/tlpkg/installer/install-menu-text.pl b/Master/tlpkg/installer/install-menu-text.pl index 907e4c8f5e5..5f4c4e07b55 100755 --- a/Master/tlpkg/installer/install-menu-text.pl +++ b/Master/tlpkg/installer/install-menu-text.pl @@ -111,6 +111,109 @@ sub prompt { # reference to another menu or to itself. sub run_menu_text { my (@args) = @_; + my $default = 0; + # select mirror if -select-mirror is given + if ($::opt_select_repository) { + # network is always available + my @mirror_list = TeXLive::TLUtils::create_mirror_list(); + print "Please select a repository:\n"; + print "Network repositories:\n" if ($#media_available >= 0); + my @sel_to_index; + my $selind = 0; + # this is for 0 mirror.ctan.org, but it is printed last! + push @sel_to_index, 0; + $selind++; + for my $i (0..$#mirror_list) { + if ($mirror_list[$i] !~ m/^ /) { + print "$mirror_list[$i]\n"; + } else { + print "[$selind] $mirror_list[$i]\n"; + push @sel_to_index, $i; + $selind++; + } + } + print "---\n"; + print "[0] default mirror - http://mirror.ctan.org\n"; + my $local_ind = "a"; + if ($#media_available >= 0) { + print "Locally present repositories:\n"; + # we have some local media present, propose to use it + for my $l (@media_available) { + my ($a, $b) = split ('#', $l); + if ($a eq 'local_compressed') { + print "[$local_ind] compressed archive at $b\n"; + $default = $local_ind; + #$local_ind = chr(ord($local_ind)+1); + $local_ind++; + } elsif ($a eq 'local_uncompressed') { + print "[$local_ind] uncompressed archive at $b\n"; + $default = $local_ind; + $local_ind++; + } elsif ($a eq 'NET') { + print "[$local_ind] cmd line repository: $b\n"; + $default = $local_ind; + $local_ind++; + } else { + printf STDERR "Unknown media $l\n"; + } + } + } + print "[q] quit\n"; + $selind--; + my $selstr = "Your selection "; + if ($local_ind ne "a") { + # we got at least some local repository + if ($local_ind eq "b") { + $selstr .= "(a,0-$selind,q)"; + $local_ind = chr(ord($local_ind)-1); + } else { + # that does not work!!! + #$local_ind--; + $local_ind = chr(ord($local_ind)-1); + $selstr .= "(a-$local_ind,0-$selind,q)"; + } + } + $selstr .= " [$default]: "; + my $got_answer = 0; + my $ans = undef; + while (!defined($ans)) { + print $selstr; + $ans = readline(*STDIN); + if (!defined($ans)) { + print "Please select 'q' for quitting the program!\n"; + } else { + chomp($ans); + $ans = $default if ($ans eq ""); + if ($ans =~ m/^[0-9]+$/) { + if (0 <= $ans && $ans <= $selind) { + my $mfull; + if ($ans == 0) { + $::init_remote_needed = 'ctan'; + } else { + # only if something else but the predefined mirror is selected + # we something here + $mfull = TeXLive::TLUtils::extract_mirror_entry($mirror_list[$sel_to_index[$ans]]); + print "selected mirror: ", $mfull, "\n"; + $::init_remote_needed = $mfull; + } + } + } elsif ($ans =~ m/^[a-$local_ind]$/) { + my $i = ord($ans) - ord('a'); + my $t = $media_available[$i]; + $t =~ s/^[^#]*#//; + $::init_remote_needed = $t; + } elsif ($ans eq 'q' || $ans eq 'Q') { + print "Good bye.\n"; + exit 0; + } else { + print "Not a valid answer.\n"; + $ans = undef; + } + } + } + } + # run remote init + do_remote_init($::init_remote_needed); # the text mode installer does not take interest in any argument # but the -old-installation-found while (@args) { 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, -- cgit v1.2.3