From 9d5bc14f41bbd9219da5d024b1d6a164b51c8525 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Sun, 24 Apr 2011 15:44:14 +0000 Subject: Proposed updates TLWinGoo and install-tl now in place; old tlperl removed git-svn-id: svn://tug.org/texlive/trunk@22184 c570f23f-e606-0410-a88d-b1316a301751 --- Master/install-tl | 300 +++-- Master/tlpkg/TeXLive/TLWinGoo.pm | 615 +++++----- Master/tlpkg/dev/tlwingoonew/README | 1 - Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm | 1286 --------------------- Master/tlpkg/installer/install-menu-perltk-new.pl | 1058 ----------------- Master/tlpkg/installer/install-menu-perltk.pl | 218 ++-- Master/tlpkg/installer/install-menu-text-new.pl | 1073 ----------------- Master/tlpkg/installer/install-menu-text.pl | 194 ++-- 8 files changed, 737 insertions(+), 4008 deletions(-) delete mode 100644 Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm delete mode 100644 Master/tlpkg/installer/install-menu-perltk-new.pl delete mode 100755 Master/tlpkg/installer/install-menu-text-new.pl diff --git a/Master/install-tl b/Master/install-tl index 79e7948e04d..eaab2f61732 100755 --- a/Master/install-tl +++ b/Master/install-tl @@ -3,7 +3,7 @@ # # Copyright 2007, 2008, 2009, 2010 Reinhard Kotucha, Norbert Preining, # Karl Berry. -# +# # This file is licensed under the GNU General Public License version 2 # or any later version. # @@ -142,12 +142,12 @@ our %vars=( # 'n_' means 'number of'. 'src_splitting_supported' => 1, 'doc_splitting_supported' => 1, 'selected_scheme' => $default_scheme, - 'from_dvd' => 0, + 'in_place' => 0, 'portable' => 0, ); # option handling -my $opt_from_dvd = 0; +my $opt_in_place = 0; my $opt_gui = (win32() ? "wizard" : "text"); my $opt_help = 0; my $opt_location = ""; @@ -201,7 +201,7 @@ process_logging_options(); GetOptions( "custom-bin=s" => \$opt_custom_bin, "fancyselector" => \$::alternative_selector, - "from_dvd" => \$opt_from_dvd, + "in-place" => \$opt_in_place, "gui:s" => \$opt_gui, "lang=s" => \$::opt_lang, "location|url|repository|repo=s" => \$opt_location, @@ -259,6 +259,15 @@ if ($opt_version) { exit 0; } +die "Options custom-bin and in-place are incompatible." + if ($opt_in_place and $opt_custom_bin); + +die "Options profile and in-place are incompatible." + if ($opt_in_place and $opt_profile); + +die "Options profile-seed and in-place are incompatible." + if ($opt_in_place and $opt_profileseed); + if ($#ARGV >= 0) { # we still have arguments left, should only be gui, otherwise die if ($ARGV[0] =~ m/^gui$/i) { @@ -273,7 +282,7 @@ if (defined($::opt_lang)) { $::lang = $::opt_lang; } -if ($opt_profile) { +if ($opt_profile) { # for now, not allowed if in_place if (-r $opt_profile) { info("Automated TeX Live installation using profile: $opt_profile\n"); } else { @@ -399,9 +408,9 @@ if ($location =~ m!^(ctan$|(http|ftp)://)!i) { if (member('local_compressed', @media_available)) { $media = 'local_compressed'; - # for from_dvd option we want local_uncompressed media if possible - $media = 'local_uncompressed' if - $opt_from_dvd && member('local_uncompressed', @media_available); + # 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'; } else { @@ -440,11 +449,15 @@ if ($media eq "local_uncompressed") { } info("Directory for temporary files: $system_tmpdir\n"); -if ($opt_from_dvd and ($media ne "local_uncompressed")) { - print "Not running from DVD; 'from_dvd' option not applicable\n"; - $opt_from_dvd = 0; +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{'from_dvd'} = $opt_from_dvd; +$vars{'in_place'} = $opt_in_place; +$opt_scheme = "" if $opt_in_place; $vars{'portable'} = $opt_portable; load_tlpdb(); @@ -591,9 +604,9 @@ if (!$finished) { # win32: first, remove trailing slash from texdir[w] # in case it is the root of a drive $vars{'TEXDIR'} =~ s![/\\]$!!; - $vars{'TEXDIRW'} =~ s![/\\]$!!; + #$vars{'TEXDIRW'} = $vars{'TEXDIR'}; # no longer used sanitise_options(); - info("Installing to: $vars{TEXDIRW}\n"); + info("Installing to: $vars{TEXDIR}\n"); do_installation(); } @@ -619,9 +632,17 @@ sub do_installation { exit 1; } # do the actual installation - my $h; - prepare_installation(); - if (!$vars{'from_dvd'}) { + make_var_skeleton "$vars{'TEXMFSYSVAR'}"; + make_local_skeleton "$vars{'TEXMFLOCAL'}"; + mkdirhier "$vars{'TEXMFSYSCONFIG'}"; + + if ($vars{'in_place'}) { + $localtlpdb = $tlpdb; + } else { + $localtlpdb=new TeXLive::TLPDB; + $localtlpdb->root("$vars{'TEXDIR'}"); + } + if (!$vars{'in_place'}) { calc_depends(); save_options_into_tlpdb(); do_install_packages(); @@ -650,7 +671,7 @@ sub do_installation { $localtlpdb->add_tlpobj($stlp); } } - $localtlpdb->save unless $vars{'from_dvd'}; + $localtlpdb->save unless $vars{'in_place'}; do_postinst_stuff(); if (win32() || $vars{'portable'}) { print welcome(); @@ -665,7 +686,6 @@ sub do_installation { # of former times, and should be critically checked. sub do_postinst_stuff { my $TEXDIR="$vars{'TEXDIR'}"; - my $TEXDIRW="$vars{'TEXDIRW'}"; my $TEXMFSYSVAR="$vars{'TEXMFSYSVAR'}"; my $TEXMFSYSCONFIG="$vars{'TEXMFSYSCONFIG'}"; my $TEXMFVAR="$vars{'TEXMFVAR'}"; @@ -684,9 +704,7 @@ sub do_postinst_stuff { # # create package backup directory for tlmgr autobackup to work - # unless installation is on non-writable media (from_dvd or live) - mkdirhier("$TEXDIR/$TeXLive::TLConfig::PackageBackupDir") - if ($vars{'TEXDIR'} eq $vars{'TEXDIRW'}); + mkdirhier("$TEXDIR/$TeXLive::TLConfig::PackageBackupDir"); # final program execution # we have to do several things: @@ -697,26 +715,22 @@ sub do_postinst_stuff { # Step 1: Clean the environment. %origenv = %ENV; - my @TMFVARS0=qw(VARTEXFONTS + my @TMFVARS=qw(VARTEXFONTS TEXMF SYSTEXMF VARTEXFONTS TEXMFDBS WEB2C TEXINPUTS TEXFORMATS MFBASES MPMEMS TEXPOOL MFPOOL MPPOOL PSHEADERS TEXFONTMAPS TEXPSHEADERS TEXCONFIG TEXMFCNF TEXMFMAIN TEXMFDIST TEXMFLOCAL TEXMFSYSVAR TEXMFSYSCONFIG TEXMFVAR TEXMFCONFIG TEXMFHOME TEXMFCACHE); - if (defined($ENV{'TEXMFCNF'}) and !$vars{'from_dvd'}) { + if (defined($ENV{'TEXMFCNF'})) { print "WARNING: environment variable TEXMFCNF is set. You should know what you are doing. We will remove that for the post install actions, but all further operations might be disturbed.\n\n"; } - foreach $tmv (@TMFVARS0) { + foreach $tmv (@TMFVARS) { delete $ENV{$tmv} if (defined($ENV{$tmv})); } - if ($vars{'from_dvd'}) { - $ENV{'TEXMFSYSVAR'} = $vars{'TEXMFSYSVAR'}; - $ENV{'TEXMFCNF'} = $vars{'TEXMFSYSVAR'}."/web2c"; - } # Step 2: Setup the PATH, switch to the new Perl @@ -761,9 +775,10 @@ operations might be disturbed.\n\n"; # post install actions # - # in case we are running from DVD we use the tlpdb from the DVD, otherwise + # in case we are running from local_uncompressed + # we use the tlpdb from the local_uncompressed, otherwise # the one we have locally created, for all the further actions - my $usedtlpdb = $vars{'from_dvd'} ? $tlpdb : $localtlpdb; + my $usedtlpdb = $vars{'in_place'} ? $tlpdb : $localtlpdb; if (win32()) { @@ -771,16 +786,16 @@ operations might be disturbed.\n\n"; debug 'Effective TEXMFCNF: '.`kpsewhich -expand-path=\$TEXMFCNF`."\n"; } - if (win32() and !$vars{'portable'}) { - create_uninstaller($vars{'TEXDIR'}, $vars{'TEXDIRW'}, + if (win32() and !$vars{'portable'} and !$vars{'in_place'}) { + create_uninstaller($vars{'TEXDIR'}, $vars{'TEXDIR'}, $vars{'TEXMFSYSVAR'}, $vars{'TEXMFSYSCONFIG'}); + # TODO: custom uninstaller for in_place # (re-)initialize batchfile for uninstalling shortcuts - mkdirhier("$TEXDIRW/tlpkg/installer") if $vars{'from_dvd'}; } # Step 4: run the programs - if (!$vars{'from_dvd'}) { + if (!$vars{'in_place'}) { info("running mktexlsr $TEXDIR/texmf-dist $TEXDIR/texmf\n"); system('mktexlsr', "$TEXDIR/texmf-dist", "$TEXDIR/texmf"); } @@ -862,15 +877,21 @@ operations might be disturbed.\n\n"; } # - # do path adjustments: On Windows add/remove to PATH etc, on Unix - # set symlinks + # do path adjustments: On Windows add/remove to PATH etc, + # on Unix set symlinks + # for portable, this option should be unset + # it should not be necessary to test separately for portable do_path_adjustments() if $vars{'option_path'}; # now do the system integration: # on unix this means setting up symlinks # on w32 this means adding to path, settting registry values # on both, we run the postaction directives of the tlpdb + # no need to test for portable or in_place: + # the menus (or profile?) should have set the required options do_tlpdb_postactions(); + copy("$::installerdir/tlpkg/installer/tlmenu.bat", $TEXDIR) + if $vars{'portable'}; } @@ -879,7 +900,8 @@ sub do_tlpdb_postactions { # Run the post installation code in the postaction tlpsrc entries # For now the option_desktop_integrations maps to both desktop # and menu entries, but we can split that later - my $usedtlpdb = $vars{'from_dvd'} ? $tlpdb : $localtlpdb; + # option settings already reflect portable- and in_place options. + my $usedtlpdb = $vars{'in_place'} ? $tlpdb : $localtlpdb; foreach my $package ($usedtlpdb->list_packages) { &TeXLive::TLUtils::do_postaction("install", $usedtlpdb->get_package($package), @@ -896,10 +918,6 @@ sub do_path_adjustments { if (win32()) { TeXLive::TLUtils::w32_add_to_path($vars{'TEXDIR'}.'/bin/win32', $vars{'option_w32_multi_user'}); - # - # from_dvd stuff - # setenv_reg('TEXMFSYSVAR', $vars{'TEXMFSYSVAR'}) if $vars{'from_dvd'}; - setenv_reg('TEXMFCNF', $vars{'TEXMFSYSVAR'}.'/web2c') if $vars{'from_dvd'}; broadcast_env(); } else { TeXLive::TLUtils::add_symlinks($vars{'TEXDIR'}, $vars{'this_platform'}, @@ -917,12 +935,11 @@ sub do_texmf_cnf { my @texmfcnflines = ; close(TMF); - my @newtmf = (); # running from dvd: write whole new texmf.cnf my @changedtmf = (); # install to disk: write only changed items my $yyyy = $TeXLive::TLConfig::ReleaseYear; my $rewritetmflua = 0; # need a new texmfcnf.lua? - + # we have to find TEXMFLOCAL TEXMFSYSVAR and TEXMFHOME foreach my $line (@texmfcnflines) { if ($line =~ m/^TEXMFLOCAL/) { @@ -930,73 +947,47 @@ sub do_texmf_cnf { # we don't have to write a new setting. my $deftmlocal = dirname($vars{'TEXDIR'}); $deftmlocal .= "/texmf-local"; - if ("$vars{'TEXMFLOCAL'}" eq "$deftmlocal") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFLOCAL = $vars{'TEXMFLOCAL'}\n"; + if ("$vars{'TEXMFLOCAL'}" ne "$deftmlocal") { push @changedtmf, "TEXMFLOCAL = $vars{'TEXMFLOCAL'}\n"; } } elsif ($line =~ m/^TEXMFSYSVAR/) { - if ("$vars{'TEXMFSYSVAR'}" eq "$vars{'TEXDIR'}/texmf-var") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFSYSVAR = $vars{'TEXMFSYSVAR'}\n"; + if ("$vars{'TEXMFSYSVAR'}" ne "$vars{'TEXDIR'}/texmf-var") { push @changedtmf, "TEXMFSYSVAR = $vars{'TEXMFSYSVAR'}\n"; } } elsif ($line =~ m/^TEXMFSYSCONFIG/) { - if ("$vars{'TEXMFSYSCONFIG'}" eq "$vars{'TEXDIR'}/texmf-config") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFSYSCONFIG = $vars{'TEXMFSYSCONFIG'}\n"; + if ("$vars{'TEXMFSYSCONFIG'}" ne "$vars{'TEXDIR'}/texmf-config") { push @changedtmf, "TEXMFSYSCONFIG = $vars{'TEXMFSYSCONFIG'}\n"; } } elsif ($line =~ m/^TEXMFVAR/) { - if ($vars{"TEXMFVAR"} eq "~/.texlive$yyyy/texmf-var") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFVAR = $vars{'TEXMFVAR'}\n"; + if ($vars{"TEXMFVAR"} ne "~/.texlive$yyyy/texmf-var") { push @changedtmf, "TEXMFVAR = $vars{'TEXMFVAR'}\n"; $rewritetmflua = 1; # TEXMFVAR change -> new texmfcnf.lua } } elsif ($line =~ m/^TEXMFCONFIG/) { - if ("$vars{'TEXMFCONFIG'}" eq "~/.texlive$yyyy/texmf-config") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFCONFIG = $vars{'TEXMFCONFIG'}\n"; + if ("$vars{'TEXMFCONFIG'}" ne "~/.texlive$yyyy/texmf-config") { push @changedtmf, "TEXMFCONFIG = $vars{'TEXMFCONFIG'}\n"; } } elsif ($line =~ m/^TEXMFHOME/) { - if ("$vars{'TEXMFHOME'}" eq "~/texmf") { - push @newtmf, $line; - } else { - push @newtmf, "TEXMFHOME = $vars{'TEXMFHOME'}\n"; + if ("$vars{'TEXMFHOME'}" ne "~/texmf") { push @changedtmf, "TEXMFHOME = $vars{'TEXMFHOME'}\n"; } } elsif ($line =~ m/^OSFONTDIR/) { if (win32()) { - push @newtmf, "OSFONTDIR = \$SystemRoot/fonts//\n"; push @changedtmf, "OSFONTDIR = \$SystemRoot/fonts//\n"; - } else { - push @newtmf, $line; } - } else { - push @newtmf, $line; } } if ($vars{'portable'}) { - push @newtmf, "ASYMPTOTE_HOME = \$TEXMFCONFIG/asymptote\n"; push @changedtmf, "ASYMPTOTE_HOME = \$TEXMFCONFIG/asymptote\n"; } - + my ($TMF, $TMFLUA); - if ($vars{'TEXDIR'} eq $vars{'TEXDIRW'}) { - # if TEXDIR == TEXDIRW we want to write only changes to texmf.cnf - # even for from_dvd installation (needed by tl-portable script to - # initialize an existing, writable installation for portable use) - $TMF = ">$vars{'TEXDIR'}/texmf.cnf"; - open(TMF, $TMF) || die "open($TMF) failed: $!"; - print TMF <enable if defined($::tldownload_server); # @@ -1451,14 +1430,14 @@ sub create_profile { if $key=~/^collection/ and $vars{$key}==1; print $fh "$key $vars{$key}\n" if $key =~ /^option_/; print $fh "$key $vars{$key}\n" if (($key =~ /^binary_/) && $vars{$key}); - print $fh "$key $vars{$key}\n" if $key =~ /^TEXDIR/; # includes TEXDIRW + print $fh "$key $vars{$key}\n" if $key =~ /^TEXDIR/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFSYSVAR/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFSYSCONFIG/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFVAR/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFCONFIG/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFLOCAL/; print $fh "$key $vars{$key}\n" if $key =~ /^TEXMFHOME/; - print $fh "$key $vars{$key}\n" if $key =~ /^from_dvd/; + print $fh "$key $vars{$key}\n" if $key =~ /^in_place/; print $fh "$key $vars{$key}\n" if $key =~ /^portable/; } if (!ref($profilepath)) { @@ -1514,20 +1493,6 @@ sub sanitise_options { $vars{'option_desktop_integration'} &&= !$vars{'portable'}; } -sub prepare_installation { - make_var_skeleton "$vars{'TEXMFSYSVAR'}"; - make_local_skeleton "$vars{'TEXMFLOCAL'}"; - mkdirhier "$vars{'TEXMFSYSCONFIG'}"; - - if ($vars{'from_dvd'}) { - $localtlpdb = $tlpdb; - } else { - $localtlpdb=new TeXLive::TLPDB; - $localtlpdb->root("$vars{'TEXDIR'}"); - } -} - - sub do_install_packages { my @what; foreach my $package (sort keys %install) { @@ -1582,10 +1547,9 @@ sub save_options_into_tlpdb { $localtlpdb->setting ("platform", $::_platform_); } $localtlpdb->setting("available_architectures", @archs); - $localtlpdb->save() unless $vars{'from_dvd'}; + $localtlpdb->save() unless $vars{'in_place'}; } - sub import_settings_from_old_tlpdb { my $dn = shift; my $tlpdboldpath = "$dn/$TeXLive::TLConfig::InfraLocation/$TeXLive::TLConfig::DatabaseName"; @@ -1626,7 +1590,6 @@ sub import_settings_from_old_tlpdb { my $oldroot = $previoustlpdb->root; my $newroot = abs_path("$oldroot/..") . "/$texlive_release"; $vars{'TEXDIR'} = $newroot; - $vars{'TEXDIRW'} = $newroot; $vars{'TEXMFSYSVAR'} = "$newroot/texmf-var"; $vars{'TEXMFSYSCONFIG'} = "$newroot/texmf-config"; # only TEXMFLOCAL is treated differently, we use what is found by kpsewhich @@ -1768,13 +1731,13 @@ sub do_cleanup { # stuff is already dumped to it and $::LOGFILE defined. So do not # redefine it if (!defined($::LOGFILE)) { - if (open(LOGF,">$vars{'TEXDIRW'}/install-tl.log")) { + if (open(LOGF,">$vars{'TEXDIR'}/install-tl.log")) { $::LOGFILE = \*LOGF; foreach my $line(@::LOGLINES) { print $::LOGFILE "$line"; } } else { - tlwarn("$0: Cannot create log file $vars{'TEXDIRW'}/install-tl.log: $!\n" + tlwarn("$0: Cannot create log file $vars{'TEXDIR'}/install-tl.log: $!\n" . "Not writing out log lines.\n"); } } @@ -1782,13 +1745,13 @@ sub do_cleanup { # remove temporary files from TEXDIR/temp if (($media eq "local_compressed") or ($media eq "NET")) { debug("Remove temporary downloaded containers...\n"); - rmtree("$vars{'TEXDIRW'}/temp") if (-d "$vars{'TEXDIRW'}/temp"); + rmtree("$vars{'TEXDIR'}/temp") if (-d "$vars{'TEXDIR'}/temp"); } # write the profile out - if ($vars{'from_dvd'}) { - create_profile("$vars{'TEXDIRW'}/texlive.profile"); - debug("Profile written to $vars{'TEXDIRW'}/texlive.profile\n"); + if ($vars{'in_place'}) { + create_profile("$vars{'TEXDIR'}/texlive.profile"); + debug("Profile written to $vars{'TEXDIR'}/texlive.profile\n"); } else { create_profile("$vars{'TEXDIR'}/$InfraLocation/texlive.profile"); debug("Profile written to $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"); @@ -1797,8 +1760,8 @@ sub do_cleanup { close($::LOGFILE) if (defined($::LOGFILE)); if (defined($::LOGFILENAME) and (-e $::LOGFILENAME)) { print "Logfile: $::LOGFILENAME\n"; - } elsif (-e "$vars{'TEXDIRW'}/install-tl.log") { - print "Logfile: $vars{'TEXDIRW'}/install-tl.log\n"; + } elsif (-e "$vars{'TEXDIR'}/install-tl.log") { + print "Logfile: $vars{'TEXDIR'}/install-tl.log\n"; } else { print "No logfile\n"; } @@ -1840,7 +1803,7 @@ sub welcome_paths { Add $::vars{'TEXDIR'}/texmf/doc/info to INFOPATH. EOF - if ($::vars{'from_dvd'} and !win32()) { + if ($::vars{'in_place'} and !win32()) { $welcome .= <<"EOF"; Set TEXMFCNF to $::vars{'TEXMFSYSVAR'}/web2c. EOF @@ -1878,7 +1841,7 @@ $texenvs ---------------------------------------------------------------------- EOF } } - + $welcome .= <<"EOF"; Welcome to TeX Live! @@ -2014,9 +1977,9 @@ Use the text mode installer (default except on Windows). (only for GUI installer) If possible, start the installer translated into the language specified by the 2-letter (ISO 639-1) language code (with -the exception for selecting simplified or traditional Chinese). +the exception for selecting simplified or traditional Chinese). Currently supported -languages: English (en, default), Czech (cs), German (de), French (fr), +languages: English (en, default), Czech (cs), German (de), French (fr), Italian (it), Dutch (nl), Polish (pl), Russian (ru), Slovak (sk), Slovenian (sl), Serbian (sr), Vietnamese (vi), simplified Chinese (zh-cn), and traditional Chinese (zh-tw). @@ -2116,10 +2079,10 @@ For Windows only: configure for the current user, not for all users. =item B<--no-persistent-downloads> For net installs, activating this option makes the installer try to set up a -persistent connection using the Net::LWP Perl module. -This opens only one connection between your computer and the server +persistent connection using the Net::LWP Perl module. +This opens only one connection between your computer and the server per session and reuses it, instead of initiating a new download for -each package. +each package. This option is turned on by default, and the installation program will fall back to using C if this is not possible. To disable usage of @@ -2127,9 +2090,18 @@ LWP and persistent connections, use C<--no-persistent-downloads>. =item B<-portable> -Install for portable use. This option minimazes the impact on the host -system making TeX Live self-contained in a single directory and -usable from portable drives. See section B below. +Install for portable use on e.g. a USB stick. Also selectable from +within the perltk- and text installers. + +=item B<-in-place> + +This is a quick-and-dirty installation option in case you already +have an rsync- or svn checkout of TeX Live. It will use the checkout +as-is and will just do the necessary post-install. Be warned that +the file tlpkg/texlive.tlpdb may be rewritten, that removal has +to be done manually, and that the only realistic way to maintain +this installation is to redo it from time to time. This option is +not available via the installer interface. USE AT YOUR OWN RISK. =item B<-print-platform> @@ -2155,7 +2127,7 @@ There is one exception to this: If the profile contains a variable for C and I collection variable is defined in the profile, then the collections which the specified scheme requires are installed. Thus, a simple line C -together with the definitions of the paths (C, C, +together with the definitions of the paths (C, C, C, C, C) suffices to install the medium scheme with all default options. @@ -2188,16 +2160,6 @@ If C<-v> has been given the revisions of the used modules are reported, too. As usual, all options can be specified with either C<-> or C<-->, and arguments can be separated from their options by either a space or C<=>. -=head1 PORTABLE USE - -The root directory of a TeX Live installation contains a shell script -C and a DOS batch file C which start up a -new shell (command prompt), in which TeX Live can be run self-contained. - -When running these scripts from a non-writable medium, some preparation -of the host system is done on the first run, in the host directory -C<~/.tlportableYYYY>. Otherwise, the host system is not touched. - =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm index 08c86c58480..26fdaf42d56 100644 --- a/Master/tlpkg/TeXLive/TLWinGoo.pm +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -1,6 +1,6 @@ # $Id$ # TeXLive::TLWinGoo.pm - Windows nastiness -# Copyright 2008, 2009, 2010 Siep Kroonenberg, Norbert Preining +# Copyright 2008, 2009, 2010, 2011 Siep Kroonenberg, Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -46,14 +46,17 @@ C -- Additional utilities for Windows TeXLive::TLWinGoo::global_tmpdir; TeXLive::TLWinGoo::get_system_path; TeXLive::TLWinGoo::get_user_path; - TeXLive::TLWinGoo::win_which_dir($prog); TeXLive::TLWinGoo::setenv_reg($env_var, $env_data); TeXLive::TLWinGoo::unsetenv_reg($env_var); TeXLive::TLWinGoo::adjust_reg_path_for_texlive($action, $texbindir, $mode); - TeXLive::TLWinGoo::register_extension($extension, $file_type); - TeXLive::TLWinGoo::unregister_extension($extension); + TeXLive::TLWinGoo::register_extension($mode, $extension, $file_type); + TeXLive::TLWinGoo::unregister_extension($mode, $extension); TeXLive::TLWinGoo::register_file_type($file_type, $command); TeXLive::TLWinGoo::unregister_file_type($file_type); + TeXLive::TLWinGoo::register_application($prog, $path, $exts); + TeXLive::TLWinGoo::unregister_application($prog); + TeXLive::TLWinGoo::add_to_openwithlist($ext, $prog); + TeXLive::TLWinGoo::remove_from_openwithlist($ext, $prog); =head2 ACTIVATING CHANGES IMMEDIATELY @@ -104,6 +107,10 @@ BEGIN { &unregister_extension ®ister_file_type &unregister_file_type + ®ister_application + &unregister_application + &add_to_openwithlist + &remove_from_openwithlist &broadcast_env &update_assocs &shell_folder @@ -120,7 +127,6 @@ BEGIN { &admin_again &get_system_env &get_user_env - &win_which_dir &global_tmpdir &is_a_texdir &tex_dirs_on_path @@ -378,31 +384,31 @@ sub get_user_path { return $value; } -=pod - -=item C - -More or less the same as which, except that 1. it returns a -directory, 2. it consults the path stored in the registry rather -than the path of the current process, and 3. it assumes that the -filename includes an extension. Currently only used for testing. - -=cut - -sub win_which_dir { - my $prog = shift; - my $d; - # first check system path - my $path = expand_string(get_system_path()); - my $user_path = expand_string(get_user_path()); - $path = $path . ';' . $user_path if $user_path; - $path =~ s/\\/\//g; - foreach $d (split (';',$path)) { - $d =~ s/\/$//; - return $d if -e $d.'/'.$prog; - } - return 0; -} +#=pod +# +#=item C +# +#More or less the same as which, except that 1. it returns a +#directory, 2. it consults the path stored in the registry rather +#than the path of the current process, and 3. it assumes that the +#filename includes an extension. Currently only used for testing. +# +#=cut +# +#sub win_which_dir { +# my $prog = shift; +# my $d; +# # first check system path +# my $path = expand_string(get_system_path()); +# my $user_path = expand_string(get_user_path()); +# $path = $path . ';' . $user_path if $user_path; +# $path =~ s/\\/\//g; +# foreach $d (split (';',$path)) { +# $d =~ s/\/$//; +# return $d if -e $d.'/'.$prog; +# } +# return 0; +#} =pod @@ -425,7 +431,7 @@ sub setenv_reg { if ($mode eq "system" and !$is_admin); my $env; if ($mode ne "system") { - my $env = get_user_env(); + $env = get_user_env(); $env->ArrayValues(1); $env->{'/'.$env_var} = [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; @@ -545,16 +551,28 @@ sub adjust_reg_path_for_texlive { return 0; } +### helper subs for file types ### + # delete a registry key recursively. # the key parameter should be a string, not a registry object. -# We shall use this with file types. + +sub getans { + my $prompt = shift; + my $ans; + print STDERR "$prompt\n"; + $ans = ; + if ($ans =~ /^y/i) {return 1;} + die "Aborting as requested"; +} sub reg_delete_recurse { my $parent = shift; my $childname = shift; - ddebug("Deleting $childname regkey\n"); + my $parentpath = $parent->Path; + ddebug("Deleting $parentpath$childname\n"); + my $child; if ($childname !~ '^/') { # subkey - my $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); + $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); return unless $child; foreach my $v (keys %$child) { if ($v =~ '^/') { # value @@ -568,106 +586,214 @@ sub reg_delete_recurse { delete $parent->{$childname}; } -=pod - -=item C - -Add registry entry to associate $extension with $file_type. Slashes -are flipped where necessary. +sub cu_root { + my $k = $Registry -> Open("CUser", { + Access => KEY_ALL_ACCESS(), Delimiter => '/' + }); + die "Cannot open HKCU for writing" unless $k; + return $k; +} -If $mode is 0, nothing is actually done. If $mode is 1, only not-present -keys of keys that are matching the given key are (re)created. If $mode -is 2 then keys are (re)created in any case. +sub lm_root { + my $k = $Registry -> Open("LMachine", { + Access => ($is_admin ? KEY_ALL_ACCESS() : KEY_READ()), + Delimiter => '/' + }); + die "Cannot open HKLM for ".($is_admin ? "writing" : "reading") + unless $k; + return $k; +} -=cut +# write a registry key or not, depending on +# mode, existing keys and privilege level -sub register_extension { +sub do_write_regkey { my $mode = shift; - return if ($mode == 0); - - my $extension = shift; - $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot - $extension = uc($extension); + my $keypath = shift; # modulo cu/lm + my $keyhash = shift; # ref to a possibly nested hash + die "No regkey specified" unless $keypath && defined($keyhash); + # for error reporting: + my $hivename = $is_admin ? 'HKLM' : 'HKCU'; + + if ($mode == 0) { + ddebug "Mode 0: not writing $hivename/$keypath key\n"; + return 1; + } - my $file_type = shift; - debug("Linking $extension to $file_type\n"); - my ($classes_key_path, $classes_key, $k); - my ($admin_classes_key_path, $admin_classes_key); + # split into parent and final subkey + # remove initial slash from parent + # ensure subkey ends with slash + my ($parentpath, $keyname); + if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { + ($parentpath, $keyname) = ($1, $2); + $keyname .= '/'; + debug "key - $hivename - $parentpath - $keyname\n"; + } else { + die "Cannot determine final component of $keypath"; + } - $extension = lc($extension); + my $cu_key = cu_root(); + my $lm_key = lm_root(); + # cu_root() and lm_root() already die upon failure + my $do_create = 1; + if ($mode == 1) { + if ($is_admin) { + if ($lm_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKLM/$keypath because already present\n"; + } + } else { + if ($cu_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKCU/$keypath because already present\n"; + } elsif ($lm_key->{$keypath}) { + $do_create = 0; + debug "Not writing HKCU/$keypath because ". + "HKLM/$keypath already present\n"; + } + } + }; + return 1 unless $do_create; + my $parentkey; if ($is_admin) { - $classes_key_path = "LMachine/Software/Classes/"; + $parentkey = $lm_key->Open($parentpath); + if (!$parentkey) { + # in most cases, this probably shouldn't happen for lm + $parentkey = $lm_key->CreateKey($parentpath); + } } else { - $classes_key_path = "CUser/Software/Classes/"; - $admin_classes_key_path = "LMachine/Software/Classes/"; + $parentkey = $cu_key->Open($parentpath); + if (!$parentkey) { + $parentkey = $cu_key->CreateKey($parentpath); + } } - - $classes_key = $Registry -> Open($classes_key_path, - {Access => KEY_ALL_ACCESS()}); - - if (!$is_admin) { - $admin_classes_key = $Registry -> Open($admin_classes_key_path, - {Access => KEY_READ()}); + if (!$parentkey) { + tlwarn "Cannot create parent of $hivename/$keypath\n"; + return 0; } + if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} + $parentkey->{$keyname} = $keyhash; + if (!$parentkey->{$keyname}) { + tlwarn "Failure to create HKLM/$keypath\n"; + return 0; + } + if ($is_admin and $cu_key->{$keypath}) { + # delete possibly conflicting cu key + reg_delete_recurse ($cu_key->{$parentpath}, $keyname); + } + if (!$parentkey) { + $parentkey = $cu_key->CreateKey($parentpath); + if (!$parentkey) { + tlwarn "Cannot create parentpath of HKCU/$keypath\n"; + return 0; + } + } + if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} + $parentkey->{$keyname} = $keyhash; + if (!$parentkey->{$keyname}) { + tlwarn "Failure to create $hivename/$keypath\n"; + return 0; + } + return 1; +} - if (!defined($classes_key)) { - tlwarn("Cannot get key to $classes_key\n" . - "Cannot continue setting up associations.\n"); - # should we die here in the admin case? - # so it was before, but that is probably not the best idea - return; +sub do_remove_regkey { + my $mode = shift; + my $keypath = shift; + my $testhash = shift; + # hashref of subkey/value => data pairs + # mode 1: if any is present and does not match, then do not remove + # ATM we assume REG_SZ data + # In future, a we might use a subroutine reference instead. + my $hivename = $is_admin ? 'HKLM' : 'HKCU'; + + if ($mode == 0) { + ddebug "Mode 0: not removing $hivename/$keypath key\n"; + return 1; } - my $do_create_key = 0; + my ($parentpath, $keyname); + if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { + ($parentpath, $keyname) = ($1, $2); + $keyname .= '/'; + } else { + die "Cannot determine final component of $keypath"; + } + my $cu_key = cu_root(); + my $lm_key = lm_root(); + if ($is_admin) { + return 0 unless $lm_key; + } else { + return 0 unless $cu_key; + } + my $do_remove = 1; + my ($parentkey, $k, $skv, $d); + if ($is_admin) { + $parentkey = $lm_key->Open($parentpath); + } else { + $parentkey = $cu_key->Open($parentpath); + } + if (!$parentkey) { + $do_remove = 0; + tlwarn "Unable to open $roothive/$parentpath for writing\n"; + return 0; + } if ($mode == 1) { - if (defined($classes_key->{$extension})) { - if (defined($classes_key->{$extension}->{'/'})) { - if ($classes_key->{$extension}->{'/'} eq $file_type) { - debug("register_extension: already same key $extension $file_type present, recreate it\n"); - # delete it so that it is recreated ... - delete $classes_key -> {$extension}; - $do_create_key = 1; - } else { - debug("register_extension: old foreign key" . $classes_key->{$extension}->{'/'} . " found, not changing\n"); + $k = $parentkey->{$keyname}; + if ($k) { + if ($testhash) {foreach $skv (keys %$testhash) { + $d = $k->{$keyname.$skv}; + if ($d and $d ne $test->{$skv}) { + $do_remove = 0; + debug "$hivename/$keypath modified; not deleting\n"; + last; } - } + }} } else { - if (!$is_admin) { - # if we are not admin, we check whether the key is associated - # in the admin keys, and if yes, do NOT associate it again - if (defined($admin_classes_key->{$extension})) { - debug("register_extension: old key $extension found in admins keys, not changing it\n"); - } else { - $do_create_key = 1; - } - } else { - $do_create_key = 1; - } - debug("register_extension: old key $extension not found, recreating it\n") - if $do_create_key; + $do_remove = 0; + debug "$hivename/$keypath not present or not writable so not removed\n"; } - } elsif ($mode == 2) { - $do_create_key = 1; - } else { - die "Unknown mode $mode for register_extension"; + }; + return 1 unless $do_remove; + #getans("Deleting $parentpath$keyname regkey? "); + reg_delete_recurse($parentkey, $keyname); + if ($parentkey->{$keyname}) { + tlwarn "Failure to delete $roothive/$keypath\n"; + return 0; } - - if ($do_create_key) { - $k = $classes_key->CreateKey($extension); - if (!defined($k)) { - tlwarn("Cannot create key for $extension in $classes_key_path.\n"); - return; - } - $k -> ArrayValues(0); - $k -> {"/"} = $file_type; - if (admin()) { - # delete possibly conflicting value from HKCU/software - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - delete $classes_key -> {$extension}; - } + if ($is_admin and $cu_key->{$parentpath}) { + reg_delete_recurse($cu_key->{$parentpath}, $keyname); + # no errorchecking this once } + return 1; +} + +=pod + +=item C + +Add registry entry to associate $extension with $file_type. Slashes +are flipped where necessary. + +If $mode is 0, nothing is actually done. If $mode is 1, only not-present +keys of keys that are matching the given key are (re)created. If $mode +is 2 then keys are (re)created in any case. + +=cut + +sub register_extension { + my $mode = shift; + my $extension = shift; + # ensure leading dot + $extension = '.'.$extension unless $extension =~ /^\./; + $extension = lc($extension); + + my $file_type = shift; + debug("Linking $extension to $file_type\n"); + + my $regkey = {'/' => $file_type}; + do_write_regkey($mode, "Software/Classes/$extension/", $regkey); } =pod @@ -679,67 +805,17 @@ Reversal of register_extension. =cut sub unregister_extension { - my $mode = shift; - return if ($mode == 0); - # we don't error check; we just do the best we can. + my $mode = shift; + # mode 0: continue anyhow and let do_remove_regkey + # bail out with a debug message. my $extension = shift; my $filetype = shift; - $extension = '.'.$extension unless $extension =~ /^\./; # ensure leading dot - $extension = uc($extension); + $extension = '.'.$extension unless $extension =~ /^\./; debug("unregistering $extension\n"); - my $classes_key; - - my $HKLMclasses_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - my $HKCUclasses_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if (admin()) { - $classes_key = $HKLMclasses_key; - } else { - $classes_key = $HKCUclasses_key; - } - if ($classes_key) { - my $do_remove_key = 0; - if ($mode == 1) { - if (defined($classes_key->{$extension})) { - if (defined($classes_key->{$extension}->{'/'})) { - if ($classes_key->{$extension}->{'/'} eq $filetype) { - debug("unregister_extension: correct key/value $extension/$filetype found, removing\n"); - $do_remove_key = 1; - } else { - debug("unregister_extension: foreign value for $extension found, keeping it\n"); - } - } else { - $do_remove_key = 1; - } - } else { - # nothing necessary, this key wasn't found - } - } elsif ($mode == 2) { - $do_remove_key = 1; - } else { - die "Unknown mode $mode for unregister_extension"; - } - - if ($do_remove_key) { - reg_delete_recurse ($classes_key, $extension."/"); - if (admin()) { - if ($HKCUclasses_key) { - reg_delete_recurse ($HKCUclasses_key, $extension."/"); - } else { - debug("Cannot open HKCU classes for write\n"); - } - } - } - } else { - if (admin()) { - debug("Cannot open HKLM classes for write\n"); - } else { - debug("Cannot open HKCU classes for write\n"); - } - } + $testhash = {"/" => $filetype}; + do_remove_regkey($mode, "Software/Classes/".$extension, $testhash); } =pod @@ -757,25 +833,16 @@ sub register_file_type { my $command = shift; $command =~s/\//\\/g; debug ("Linking $file_type to $command\n"); - my ($classes_key, $k); - - if ($is_admin) { - $classes_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}) or die "Cannot open classpath"; - $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/"); - $k -> {"/"} = $command; - $k -> ArrayValues(0); - # delete possibly conflicting values from HKCU/software - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - reg_delete_recurse($classes_key, $file_type); - } else { - $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - $k = $classes_key->CreateKey($file_type."/Shell/Open/Command/"); - $k -> ArrayValues(0); - $k -> {"/"} = $command; - } + my $keyhash = { + "shell/" => { + "open/" => { + "command/" => { + "/" => $command + } + } + } + }; + do_write_regkey(2, "Software/Classes/$file_type", $keyhash); } =pod @@ -790,24 +857,80 @@ sub unregister_file_type { # we don't error check; we just do the best we can. my $file_type = shift; debug ("unregistering $file_type\n"); + do_remove_regkey(2, "Software/Classes/$file_type/"); +} - my $classes_key = $Registry -> Open("CUser/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if ($classes_key) { - reg_delete_recurse ($classes_key, $file_type."/"); - } else { - tlwarn("Cannot open HKCU classes for write\n"); - } - if ($is_admin) { - $classes_key = $Registry -> Open("LMachine/Software/Classes/", - {Access => KEY_ALL_ACCESS()}); - if ($classes_key) { - reg_delete_recurse ($classes_key, $file_type."/"); - } else { - debug ("Cannot open HKLM classes for write\n"); - } - #reg_delete_recurse ($classes_key, $file_type); - } +=pod + +=item C + +Add registry entry to set full path of $prog to $path and optionally +specify which extensions it handles + +=cut + +sub register_application { + my $prog = shift; # redundant, but more natural than just $path + my $path = shift; + my $exts = shift; + + my $hsh; + foreach my $e (@$exts) {$hsh->{"/$e"} = "";} + #my $prog = TeXLive::TLUtils::basename($path); + $cmd = "\"$path\" \"%1\""; + $cmd =~ s!/!\\!g; + my $keyhash = { + "shell/" => { + "open/" => { + "command/" => { + "/" => $cmd + } + } + }, + "SupportedTypes" => $hsh + }; + do_write_regkey(2, "Software/Classes/Applications/$prog", $keyhash); +} + +=pod + +=item C + +Reversal of register_application + +=cut + +sub unregister_application { + my $prog = shift; + do_remove_regkey(2, "Software/Classes/Applications/$prog/"); +} + +=pod + +=item C + +Add $prog to the list of programs which open $ext files + +=cut + +sub add_to_openwithlist { + my $ext = shift; + my $prog = shift; + do_write_regkey(2, "Software/Classes/$ext/OpenWithList/$prog", {}); +} + +=pod + +=item C + +Remove $prog from the list of programs which open $ext files + +=cut + +sub remove_from_openwithlist { + my $ext = shift; + my $prog = shift; + do_remove_regkey(2, "Software/Classes/$ext/OpenWithList/$prog"); } =pod @@ -907,14 +1030,16 @@ sub shell_folder { if (admin()) { return 0 unless $admin_name; $shell_key = $Registry->Open( - "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - {Access => KEY_READ}); - $sh_folder = short_name($shell_key -> {"/$admin_name"}); + "LMachine/software/microsoft/windows/currentversion/explorer/user shell folders/", + {Access => KEY_READ}) or return 0; + $sh_folder = $shell_key -> {"/$admin_name"}; + $sh_folder = short_name(expand_string($sh_folder)); } else { $shell_key = $Registry->Open( - "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - {Access => KEY_READ}); - $sh_folder = short_name($shell_key -> {"/$user_name"}); + "CUser/software/microsoft/windows/currentversion/explorer/user shell folders/", + {Access => KEY_READ}) or return 0; + $sh_folder = $shell_key -> {"/$user_name"}; + $sh_folder = short_name(expand_string($sh_folder)); } $sh_folder =~ s!\\!/!g; return $sh_folder; @@ -922,38 +1047,10 @@ sub shell_folder { sub desktop_path() { return shell_folder('Desktop'); - #my ($shell_key, $deskpath); - #if (admin()) { - # $shell_key = $Registry->Open( - # "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $deskpath = short_name($shell_key -> {"/Common Desktop"}); - #} else { - # $shell_key = $Registry->Open( - # "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $deskpath = short_name($shell_key -> {"/Desktop"}); - #} - #$deskpath =~ s!\\!/!g; - #return $deskpath; } sub menu_path() { return shell_folder('Programs', 'Common Programs'); - #my ($shell_key, $menupath); - #if (admin()) { - # $shell_key = $Registry->Open( - # "LMachine/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $menupath = short_name($shell_key -> {"/Common Programs"}); - #} else { - # $shell_key = $Registry->Open( - # "CUser/software/microsoft/windows/currentversion/explorer/shell folders/", - # {Access => KEY_READ}); - # $menupath = short_name($shell_key -> {"/Programs"}); - #} - #$menupath =~ s!\\!/!g; - #return $menupath; } =pod @@ -1063,16 +1160,12 @@ the job. =cut sub create_uninstaller { - my ($tdfw, $tdwfw, $tdsvfw, $tdscfw) = @_; - # TEXDIR, TEXDIRW, TEXMFSYSVAR, TEXMFSYSCONFIG + my ($tdfw, $tdsvfw, $tdscfw) = @_; + # TEXDIR, TEXMFSYSVAR, TEXMFSYSCONFIG $tdfw =~ s![\\/]$!!; my $td = $tdfw; $td =~ s!/!\\!g; - $tdwfw =~ s![\\/]$!!; - my $tdw = $tdwfw; - $tdw =~ s!/!\\!g; - $tdsvfw =~ s![\\/]$!!; my $tdsv = $tdsvfw; $tdsv =~ s!/!\\!g; @@ -1087,12 +1180,12 @@ sub create_uninstaller { my $k = $uninst_key->CreateKey( "uninstall/TeXLive$::TeXLive::TLConfig::ReleaseYear/"); $k->{"/DisplayName"} = "TeX Live $::TeXLive::TLConfig::ReleaseYear"; - $k->{"/UninstallString"} = "\"$tdw\\tlpkg\\installer\\uninst.bat\""; + $k->{"/UninstallString"} = "\"$td\\tlpkg\\installer\\uninst.bat\""; $k->{'/DisplayVersion'} = $::TeXLive::TLConfig::ReleaseYear; $k->{'/URLInfoAbout'} = "http://www.tug.org/texlive"; - mkdirhier("$tdwfw/tlpkg/installer"); # wasn't this done yet? - if (open UNINST, ">$tdwfw/tlpkg/installer/uninst.bat") { + mkdirhier("$tdfw/tlpkg/installer"); # wasn't this done yet? + if (open UNINST, ">$tdfw/tlpkg/installer/uninst.bat") { print UNINST <$tdwfw/tlpkg/installer/uninst2.bat") { - print UNINST2 <$tdfw/tlpkg/installer/uninst2.bat") { + print UNINST2 <nul -del \"$tdw\\release-texlive.txt\" +rmdir /s /q \"$td\\temp\" +rmdir /s /q \"$td\\tlpkg\" +del \"$td\\install-tl.log\" +del \"$td\\texlive.profile\" 2>nul +del \"$td\\release-texlive.txt\" set test= -for \%\%f in (\"$tdw\\*.*\") do \@set test=nonempty -if x\%test\%==x rd \"$tdw\" +for \%\%f in (\"$td\\*.*\") do \@set test=nonempty +if x\%test\%==x rd \"$td\" \@echo Done uninstalling TeXLive. rem \@pause del %0 @@ -1150,7 +1243,7 @@ UNEND2 ; close UNINST2; } else { - warn "Cannot open $tdwfw/tlpkg/installer/uninst2.bat for writing"; + warn "Cannot open $tdfw/tlpkg/installer/uninst2.bat for writing"; } } diff --git a/Master/tlpkg/dev/tlwingoonew/README b/Master/tlpkg/dev/tlwingoonew/README index 88f266406ea..5ea6bc33add 100644 --- a/Master/tlpkg/dev/tlwingoonew/README +++ b/Master/tlpkg/dev/tlwingoonew/README @@ -1,4 +1,3 @@ Testing: -- replace original TLWinGoo with this one - put testw32[.bat] in root of installation or svn/rsync checkout diff --git a/Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm b/Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm deleted file mode 100644 index bd15e2d517f..00000000000 --- a/Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm +++ /dev/null @@ -1,1286 +0,0 @@ -# $Id: TLWinGoo.pm 19264 2010-07-07 00:06:03Z trzeciak $ -# TeXLive::TLWinGoo.pm - Windows nastiness -# Copyright 2008, 2009, 2010, 2011 Siep Kroonenberg, Norbert Preining -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -# code for broadcast_env adapted from Win32::Env: -# Copyright 2006 Oleg "Rowaa[SR13]" V. Volkov, all rights reserved. -# This program is free software; you can redistribute it and/or modify it -# under the same terms as Perl itself. - -package TeXLive::TLWinGoo; - -my $svnrev = '$Revision: 19264 $'; -my $_modulerevision; -if ($svnrev =~ m/: ([0-9]+) /) { - $_modulerevision = $1; -} else { - $_modulerevision = "unknown"; -} -sub module_revision { - return $_modulerevision; -} - -=pod - -=head1 NAME - -C -- Additional utilities for Windows - -=head2 SYNOPSIS - - use TeXLive::TLWinGoo; - -=head2 DIAGNOSTICS - - TeXLive::TLWinGoo::win_version; - TeXLive::TLWinGoo::is_vista; - TeXLive::TLWinGoo::admin; - TeXLive::TLWinGoo::non_admin; - TeXLive::TLWinGoo::reg_country; - -=head2 ENVIRONMENT AND REGISTRY - - TeXLive::TLWinGoo::expand_string($s); - TeXLive::TLWinGoo::global_tmpdir; - TeXLive::TLWinGoo::get_system_path; - TeXLive::TLWinGoo::get_user_path; - TeXLive::TLWinGoo::setenv_reg($env_var, $env_data); - TeXLive::TLWinGoo::unsetenv_reg($env_var); - TeXLive::TLWinGoo::adjust_reg_path_for_texlive($action, $texbindir, $mode); - TeXLive::TLWinGoo::register_extension($mode, $extension, $file_type); - TeXLive::TLWinGoo::unregister_extension($mode, $extension); - TeXLive::TLWinGoo::register_file_type($file_type, $command); - TeXLive::TLWinGoo::unregister_file_type($file_type); - TeXLive::TLWinGoo::register_application($prog, $path, $exts); - TeXLive::TLWinGoo::unregister_application($prog); - TeXLive::TLWinGoo::add_to_openwithlist($ext, $prog); - TeXLive::TLWinGoo::remove_from_openwithlist($ext, $prog); - -=head2 ACTIVATING CHANGES IMMEDIATELY - - TeXLive::TLWinGoo::broadcast_env; - TeXLive::TLWinGoo::update_assocs; - -=head2 SHORTCUTS - - TeXLive::TLWinGoo::desktop_path; - TeXLive::TLWinGoo::add_desktop_shortcut($texdir, $name, $icon, - $prog, $args, $batgui); - TeXLive::TLWinGoo::add_menu_shortcut($place, $name, $icon, - $prog, $args, $batgui); - TeXLive::TLWinGoo::remove_desktop_shortcut($name); - TeXLive::TLWinGoo::remove_menu_shortcut($place, $name); - -=head2 UNINSTALLER - - TeXLive::TLWinGoo::create_uninstaller; - TeXLive::TLWinGoo::unregister_uninstaller; - -All exported functions return forward slashes. - -=head2 DESCRIPTION - -=over 4 - -=cut - -BEGIN { - use Exporter; - use vars qw( @ISA @EXPORT $Registry); - @ISA = qw( Exporter ); - @EXPORT = qw( - &win_version - &is_vista - &admin - &non_admin - ®_country - &expand_string - &global_tmpdir - &get_system_path - &get_user_path - &setenv_reg - &unsetenv_reg - &adjust_reg_path_for_texlive - ®ister_extension - &unregister_extension - ®ister_file_type - &unregister_file_type - ®ister_application - &unregister_application - &add_to_openwithlist - &remove_from_openwithlist - &broadcast_env - &update_assocs - &shell_folder - &desktop_path - &add_desktop_shortcut - &add_menu_shortcut - &remove_desktop_shortcut - &remove_menu_shortcut - &create_uninstaller - &unregister_uninstaller - ); - # for testing also: - @EXPORT_OK = qw( - &admin_again - &get_system_env - &get_user_env - &global_tmpdir - &is_a_texdir - &tex_dirs_on_path - ); - if ($^O=~/^MSWin(32|64)$/i) { - require Win32::API; - require Win32::TieRegistry; - Win32::TieRegistry->import( qw( $Registry - REG_SZ REG_EXPAND_SZ KEY_READ KEY_WRITE KEY_ALL_ACCESS - KEY_ENUMERATE_SUB_KEYS ) ); - $Registry->Delimiter('/'); - $Registry->ArrayValues(0); - $Registry->FixSzNulls(1); - require Win32::Shortcut; - Win32::Shortcut->import( qw( SW_SHOWNORMAL SW_SHOWMINNOACTIVE ) ); - } -} - -use TeXLive::TLConfig; -use TeXLive::TLUtils; -TeXLive::TLUtils->import( qw( mkdirhier ) ); - -my $is_win = $^O=~/^MSWin(32|64)$/i; - -=pod - -=back - -=head2 DIAGNOSTICS - -=over 4 - -=item C - -C returns the Windows version number as stored in the -registry: 5.0 for Windows 2000, 5.1 for Windows XP and 6.0 for Vista. - -=cut - -my $windows_version = 0; - -if ($is_win) { - my $tempkey = $Registry->Open( - "LMachine/software/Microsoft/Windows NT/CurrentVersion/", - {Access => KEY_READ() }); - $windows_version = $tempkey -> { "/CurrentVersion" }; -} - -sub win_version { return $windows_version; } - -=item C - -C returns 1 if win_version is >= 6.0, otherwise 0. - -=cut - -sub is_vista { return $windows_version >= 6; } - -# permissions with which we try to access the system environment - -my $is_admin = 1; - -sub sys_access_permissions { - $is_admin ? KEY_ALL_ACCESS() : KEY_READ() | KEY_ENUMERATE_SUB_KEYS(); -} - -sub get_system_env { - return $Registry -> Open( - "LMachine/system/currentcontrolset/control/session manager/Environment/", - {Access => sys_access_permissions()}); -} - -# $is_admin was set to true originally. With this value, -# sys-access_permissions returns full access permissions. If that -# doesn't work out then apparently we aren't administrator, so we -# set $is_admin to 0. - -if ($is_win) { - $is_admin = 0 if not get_system_env(); - debug("Configuring TLWinGoo for " . - ($is_admin ? "admin" : "user") . "mode\n") if win32(); -} - -sub get_user_env { - return $Registry -> Open("CUser/Environment", {Access => KEY_ALL_ACCESS()}); -} - -=pod - -=item C - -Returns admin status, admin implying having full read-write access -to the system environment. - -=cut - -sub admin { return $is_admin; } - -=pod - -=item C - -Pretend not to have admin privileges, to enforce a user- rather than -a system install. - -Currently only used for testing. - -=cut - -sub non_admin { - debug("TLWinGoo: switching to user mode\n"); - $is_admin = 0; -} - -# just for testing; doesn't check actual user permissions -sub admin_again { - debug("TLWinGoo: switching to admin mode\n"); - $is_admin = 1; -} - -=pod - -=item C - -Two-letter country code representing the locale of the current user - -=cut - -sub reg_country { - my $value = $Registry -> {"CUser/Control Panel/International//Locale"}; - return 0 unless $value; - # there might be trailing nulls on Vista - $value =~ s/\x00*$//; - $value = substr $value, -4; - return 0 unless $value; - my $lmkey = $Registry -> Open("HKEY_CLASSES_ROOT/MIME/Database/Rfc1766/", - {Access => KEY_READ()}); - return 0 unless $lmkey; - $lm = $lmkey->{"/$value"}; - return 0 unless $lm; - debug("found lang codes value = $value, lm = $lm...\n"); - if ($lm) { - if ($lm =~ m/^zh-(tw|hk)$/i) { - return ("zh-tw"); - } elsif ($lm =~ m/^zh/) { - # for anything else starting with zh return, that is zh, zh-cn, zh-sg - # and maybe something else - return ("zh-cn"); - } else { - return(substr $lm, 0, 2); - } - } -} - -=pod - -=back - -=head2 ENVIRONMENT AND REGISTRY - -Most settings can be made for a user and for the system. User -settings override system settings. - -For admin users, the functions below affect both user- and system -settings. For non-admin users, only user settings are changed. - -An exception is the search path: the effective searchpath consists -of the system searchpath in front concatenated with the user -searchpath at the back. - -Note that in a roaming profile network setup, users take only user -settings with them to other systems, not system settings. In this -case, with a TeXLive on the network, a nonadmin install makes the -most sense. - -=over 4 - -=item C - -This function replaces substrings C<%env_var%> with their current -values as environment variable and returns the result. - -=cut - -sub expand_string { - my ($s) = @_; - $s =~ s/%([^%;]+)%/$ENV{$1} ? $ENV{$1} : "%$1%"/eg; - return $s; -} - -=pod - -=item C - -Returns the expanded value of C<%TEMP%> from the system environment, -usually C<%SystemRoot%/Temp>. This value is normally not available -from C<%ENV>. - -=cut - -if ($is_win) { - $global_tmp = expand_string(get_system_env()->{'TEMP'}) if $is_win; -} - -my $global_tmp = "/tmp"; - -sub global_tmpdir { return $global_tmp; } - -sub is_a_texdir { - my $d = shift; - $d =~ s/\\/\//g; - $d = $d . '/' unless $d =~ m!/$!; - # don't consider anything under %systemroot% a texdir - my $sr = uc($ENV{'SystemRoot'}); - $sr =~ s/\\/\//g; - $sr = $sr . '/' unless $sr =~ m!/$!; - return 0 if index($d, $sr)==0; - foreach $p qw(luatex.exe mktexlsr.exe pdftex.exe tex.exe xetex.exe) { - return 1 if (-e $d.$p); - } - return 0; -} - -=pod - -=item C - -Returns unexpanded system path, as stored in the registry, but with -forward slashes. - -=cut - -sub get_system_path { - my $value = get_system_env() -> {'/Path'}; - # Remove terminating zero bytes; there may be several, at least - # under w2k, and the FixSzNulls option only removes one. - $value =~ s/[\s\x00]+$//; - return $value; -} - -=pod - -=item C - -Returns unexpanded user path, as stored in the registry, but with -forward slashes. The user path often does not exist, and is rarely -expandable. - -=cut - -sub get_user_path { - my $value = get_user_env() -> {'/Path'}; - return "" if not $value; - $value =~ s/[\s\x00]+$//; - return $value; -} - -#=pod -# -#=item C -# -#More or less the same as which, except that 1. it returns a -#directory, 2. it consults the path stored in the registry rather -#than the path of the current process, and 3. it assumes that the -#filename includes an extension. Currently only used for testing. -# -#=cut -# -#sub win_which_dir { -# my $prog = shift; -# my $d; -# # first check system path -# my $path = expand_string(get_system_path()); -# my $user_path = expand_string(get_user_path()); -# $path = $path . ';' . $user_path if $user_path; -# $path =~ s/\\/\//g; -# foreach $d (split (';',$path)) { -# $d =~ s/\/$//; -# return $d if -e $d.'/'.$prog; -# } -# return 0; -#} - -=pod - -=item C - -Set an environment variable $env_var to $env_data. - -$mode="user": set for current user. $mode="system": set for all -users. Default: both if admin, current user otherwise. - -=cut - -sub setenv_reg { - my $env_var = shift; - my $env_data = shift; - my $mode = @_ ? shift : "default"; - die "setenv_reg: Invalid mode $mode" - if ($mode ne "user" and $mode ne "system" and $mode ne "default"); - die "setenv_reg: mode 'system' only available for admin" - if ($mode eq "system" and !$is_admin); - my $env; - if ($mode ne "system") { - $env = get_user_env(); - $env->ArrayValues(1); - $env->{'/'.$env_var} = - [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; - } - if ($mode ne "user" and $is_admin) { - $env = get_system_env(); - $env->ArrayValues(1); - $env->{'/'.$env_var} = - [ $env_data, ($env_data =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; - } -} - -=pod - -=item C - -Unset an environment variable $env_var - -=cut - -sub unsetenv_reg { - my $env_var = shift; - my $env = get_user_env(); - my $mode = @_ ? shift : "default"; - #print "Unsetenv_reg: unset $env_var with mode $mode\n"; - die "unsetenv_reg: Invalid mode $mode" - if ($mode ne "user" and $mode ne "system" and $mode ne "default"); - die "unsetenv_reg: mode 'system' only available for admin" - if ($mode eq "system" and !$is_admin); - delete get_user_env()->{'/'.$env_var} if $mode ne "system"; - delete get_system_env()->{'/'.$env_var} if ($mode ne "user" and $is_admin); -} - -=pod - -=item C - -Returns tex directories found on the search path. -A directory is a TeX directory if it contains tex.exe or -pdftex.exe. - -=cut - -sub tex_dirs_on_path { - my ($path) = @_; - my ($d, $d_exp); - my @texdirs = (); - foreach $d (split (';', $path)) { - $d_exp = expand_string($d); - if (is_a_texdir($d_exp)) { - # tlwarn("Possibly conflicting [pdf]TeX program found at $d_exp\n"); - push(@texdirs, $d_exp); - }; - } - return @texdirs; -} - -=pod - -=item C - -Edit system or user PATH variable in the registry. -Adds or removes (depending on $action) $tlbindir directory -to system or user PATH variable in the registry (depending on $mode). - -=cut - -sub adjust_reg_path_for_texlive { - my ($action, $tlbindir, $mode) = @_; - die("Unknown path action: $action\n") - if ($action ne 'add') && ($action ne 'remove'); - die("Unknown path mode: $mode\n") - if ($mode ne 'system') && ($mode ne 'user'); - debug("Warning: [pdf]tex program not found in $tlbindir\n") - if (!is_a_texdir($tlbindir)); - my $path = ($mode eq 'system') ? get_system_path() : get_user_path(); - $tlbindir =~ s!/!\\!g; - my $tlbindir_short = uc(short_name($tlbindir)); - my ($d, $d_short, @newpath); - my $tex_dir_conflict = 0; - my @texdirs; - foreach $d (split (';', $path)) { - $d_short = uc(short_name(expand_string($d))); - $d_short =~ s!/!\\!g; - ddebug("adjust_reg: compar $d_short with $tlbindir_short\n"); - if ($d_short ne $tlbindir_short) { - push(@newpath, $d); - if (is_a_texdir($d)) { - $tex_dir_conflict++; - push(@texdirs, $d); - } - } - } - if ($action eq 'add') { - if ($tex_dir_conflict) { - log("Warning: conflicting [pdf]tex program found on the $mode path ", - "in @texdirs; appending $tlbindir to the front of the path.\n"); - unshift(@newpath, $tlbindir); - } else { - push(@newpath, $tlbindir); - } - } - if (@newpath) { - debug("TLWinGoo: adjust_reg_path_for_texlive: calling setenv_reg in $mode\n"); - setenv_reg("Path", join(';', @newpath), $mode); - } else { - debug("TLWinGoo: adjust_reg_path_for_texlive: calling unsetenv_reg in $mode\n"); - unsetenv_reg("Path", $mode); - } - if ( ($action eq 'add') && ($mode eq 'user') ) { - @texdirs = tex_dirs_on_path( get_system_path() ); - return 0 unless (@texdirs); - tlwarn("Warning: conflicting [pdf]tex program found on the system path ", - "in @texdirs; not fixable in user mode.\n"); - return 1; - } - return 0; -} - -### helper subs for file types ### - -# delete a registry key recursively. -# the key parameter should be a string, not a registry object. - -sub getans { - my $prompt = shift; - my $ans; - print STDERR "$prompt\n"; - $ans = ; - if ($ans =~ /^y/i) {return 1;} - die "Aborting as requested"; -} - -sub reg_delete_recurse { - my $parent = shift; - my $childname = shift; - my $parentpath = $parent->Path; - ddebug("Deleting $parentpath$childname\n"); - my $child; - if ($childname !~ '^/') { # subkey - $child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()}); - return unless $child; - foreach my $v (keys %$child) { - if ($v =~ '^/') { # value - delete $child->{$v}; - } else { # subkey - reg_delete_recurse ($child, $v); - } - } - delete $child->{'/'}; - } - delete $parent->{$childname}; -} - -sub cu_root { - my $k = $Registry -> Open("CUser", { - Access => KEY_ALL_ACCESS(), Delimiter => '/' - }); - die "Cannot open HKCU for writing" unless $k; - return $k; -} - -sub lm_root { - my $k = $Registry -> Open("LMachine", { - Access => ($is_admin ? KEY_ALL_ACCESS() : KEY_READ()), - Delimiter => '/' - }); - die "Cannot open HKLM for ".($is_admin ? "writing" : "reading") - unless $k; - return $k; -} - -# write a registry key or not, depending on -# mode, existing keys and privilege level - -sub do_write_regkey { - my $mode = shift; - my $keypath = shift; # modulo cu/lm - my $keyhash = shift; # ref to a possibly nested hash - die "No regkey specified" unless $keypath && defined($keyhash); - # for error reporting: - my $hivename = $is_admin ? 'HKLM' : 'HKCU'; - - if ($mode == 0) { - ddebug "Mode 0: not writing $hivename/$keypath key\n"; - return 1; - } - - # split into parent and final subkey - # remove initial slash from parent - # ensure subkey ends with slash - my ($parentpath, $keyname); - if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { - ($parentpath, $keyname) = ($1, $2); - $keyname .= '/'; - debug "key - $hivename - $parentpath - $keyname\n"; - } else { - die "Cannot determine final component of $keypath"; - } - - my $cu_key = cu_root(); - my $lm_key = lm_root(); - # cu_root() and lm_root() already die upon failure - my $do_create = 1; - if ($mode == 1) { - if ($is_admin) { - if ($lm_key->{$keypath}) { - $do_create = 0; - debug "Not writing HKLM/$keypath because already present\n"; - } - } else { - if ($cu_key->{$keypath}) { - $do_create = 0; - debug "Not writing HKCU/$keypath because already present\n"; - } elsif ($lm_key->{$keypath}) { - $do_create = 0; - debug "Not writing HKCU/$keypath because ". - "HKLM/$keypath already present\n"; - } - } - }; - return 1 unless $do_create; - my $parentkey; - if ($is_admin) { - $parentkey = $lm_key->Open($parentpath); - if (!$parentkey) { - # in most cases, this probably shouldn't happen for lm - $parentkey = $lm_key->CreateKey($parentpath); - } - } else { - $parentkey = $cu_key->Open($parentpath); - if (!$parentkey) { - $parentkey = $cu_key->CreateKey($parentpath); - } - } - if (!$parentkey) { - tlwarn "Cannot create parent of $hivename/$keypath\n"; - return 0; - } - if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} - $parentkey->{$keyname} = $keyhash; - if (!$parentkey->{$keyname}) { - tlwarn "Failure to create HKLM/$keypath\n"; - return 0; - } - if ($is_admin and $cu_key->{$keypath}) { - # delete possibly conflicting cu key - reg_delete_recurse ($cu_key->{$parentpath}, $keyname); - } - if (!$parentkey) { - $parentkey = $cu_key->CreateKey($parentpath); - if (!$parentkey) { - tlwarn "Cannot create parentpath of HKCU/$keypath\n"; - return 0; - } - } - if ($parentkey->{$keyname}) {reg_delete_recurse($parentkey, $keyname);} - $parentkey->{$keyname} = $keyhash; - if (!$parentkey->{$keyname}) { - tlwarn "Failure to create $hivename/$keypath\n"; - return 0; - } - return 1; -} - -sub do_remove_regkey { - my $mode = shift; - my $keypath = shift; - my $testhash = shift; - # hashref of subkey/value => data pairs - # mode 1: if any is present and does not match, then do not remove - # ATM we assume REG_SZ data - # In future, a we might use a subroutine reference instead. - my $hivename = $is_admin ? 'HKLM' : 'HKCU'; - - if ($mode == 0) { - ddebug "Mode 0: not removing $hivename/$keypath key\n"; - return 1; - } - - my ($parentpath, $keyname); - if ($keypath =~ /^\/?(.+\/)([^\/]+)\/?$/) { - ($parentpath, $keyname) = ($1, $2); - $keyname .= '/'; - } else { - die "Cannot determine final component of $keypath"; - } - - my $cu_key = cu_root(); - my $lm_key = lm_root(); - if ($is_admin) { - return 0 unless $lm_key; - } else { - return 0 unless $cu_key; - } - my $do_remove = 1; - my ($parentkey, $k, $skv, $d); - if ($is_admin) { - $parentkey = $lm_key->Open($parentpath); - } else { - $parentkey = $cu_key->Open($parentpath); - } - if (!$parentkey) { - $do_remove = 0; - tlwarn "Unable to open $roothive/$parentpath for writing\n"; - return 0; - } - if ($mode == 1) { - $k = $parentkey->{$keyname}; - if ($k) { - if ($testhash) {foreach $skv (keys %$testhash) { - $d = $k->{$keyname.$skv}; - if ($d and $d ne $test->{$skv}) { - $do_remove = 0; - debug "$hivename/$keypath modified; not deleting\n"; - last; - } - }} - } else { - $do_remove = 0; - debug "$hivename/$keypath not present or not writable so not removed\n"; - } - }; - return 1 unless $do_remove; - #getans("Deleting $parentpath$keyname regkey? "); - reg_delete_recurse($parentkey, $keyname); - if ($parentkey->{$keyname}) { - tlwarn "Failure to delete $roothive/$keypath\n"; - return 0; - } - if ($is_admin and $cu_key->{$parentpath}) { - reg_delete_recurse($cu_key->{$parentpath}, $keyname); - # no errorchecking this once - } - return 1; -} - -=pod - -=item C - -Add registry entry to associate $extension with $file_type. Slashes -are flipped where necessary. - -If $mode is 0, nothing is actually done. If $mode is 1, only not-present -keys of keys that are matching the given key are (re)created. If $mode -is 2 then keys are (re)created in any case. - -=cut - -sub register_extension { - my $mode = shift; - my $extension = shift; - # ensure leading dot - $extension = '.'.$extension unless $extension =~ /^\./; - $extension = lc($extension); - - my $file_type = shift; - debug("Linking $extension to $file_type\n"); - - my $regkey = {'/' => $file_type}; - do_write_regkey($mode, "Software/Classes/$extension/", $regkey); -} - -=pod - -=item C - -Reversal of register_extension. - -=cut - -sub unregister_extension { - # we don't error check; we just do the best we can. - my $mode = shift; - # mode 0: continue anyhow and let do_remove_regkey - # bail out with a debug message. - my $extension = shift; - my $filetype = shift; - $extension = '.'.$extension unless $extension =~ /^\./; - debug("unregistering $extension\n"); - - $testhash = {"/" => $filetype}; - do_remove_regkey($mode, "Software/Classes/".$extension, $testhash); -} - -=pod - -=item C - -Add registry entries to associate $file_type with $command. Slashes -are flipped where necessary. Double quotes should be added by the -caller if necessary. - -=cut - -sub register_file_type { - my $file_type = shift; - my $command = shift; - $command =~s/\//\\/g; - debug ("Linking $file_type to $command\n"); - my $keyhash = { - "shell/" => { - "open/" => { - "command/" => { - "/" => $command - } - } - } - }; - do_write_regkey(2, "Software/Classes/$file_type", $keyhash); -} - -=pod - -=item C - -Reversal of register_script_type. - -=cut - -sub unregister_file_type { - # we don't error check; we just do the best we can. - my $file_type = shift; - debug ("unregistering $file_type\n"); - do_remove_regkey(2, "Software/Classes/$file_type/"); -} - -=pod - -=item C - -Add registry entry to set full path of $prog to $path and optionally -specify which extensions it handles - -=cut - -sub register_application { - my $prog = shift; # redundant, but more natural than just $path - my $path = shift; - my $exts = shift; - - my $hsh; - foreach my $e (@$exts) {$hsh->{"/$e"} = "";} - #my $prog = TeXLive::TLUtils::basename($path); - $cmd = "\"$path\" \"%1\""; - $cmd =~ s!/!\\!g; - my $keyhash = { - "shell/" => { - "open/" => { - "command/" => { - "/" => $cmd - } - } - }, - "SupportedTypes" => $hsh - }; - do_write_regkey(2, "Software/Classes/Applications/$prog", $keyhash); -} - -=pod - -=item C - -Reversal of register_application - -=cut - -sub unregister_application { - my $prog = shift; - do_remove_regkey(2, "Software/Classes/Applications/$prog/"); -} - -=pod - -=item C - -Add $prog to the list of programs which open $ext files - -=cut - -sub add_to_openwithlist { - my $ext = shift; - my $prog = shift; - do_write_regkey(2, "Software/Classes/$ext/OpenWithList/$prog", {}); -} - -=pod - -=item C - -Remove $prog from the list of programs which open $ext files - -=cut - -sub remove_from_openwithlist { - my $ext = shift; - my $prog = shift; - do_remove_regkey(2, "Software/Classes/$ext/OpenWithList/$prog"); -} - -=pod - -=back - -=head2 ACTIVATING CHANGES IMMEDIATELY - -=over 4 - -=item C - -Broadcasts system message that enviroment has changed. This only has -an effect on newly-started programs, not on running programs and the -processes they spawn. - -=cut - -sub broadcast_env() { - use constant HWND_BROADCAST => 0xffff; - use constant WM_SETTINGCHANGE => 0x001A; - my $result = ""; - my $SendMessage; - debug("Broadcasting \"Enviroment settings changed\" message...\n"); - #$SendMessage = new Win32::API('user32', 'SendMessage', 'LLPP', 'L'); - #$result = $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE, - # 0, 'Environment') if $SendMessage; - $SendMessage = new Win32::API('user32', 'SendMessageTimeout', 'LLPPLLP', 'L'); - my $ans = "12345678"; # room for dword - $result = $SendMessage->Call(HWND_BROADCAST, WM_SETTINGCHANGE, - 0, 'Environment', 0, 2000, $ans) if $SendMessage; - debug("Broadcast complete; result: $result.\n"); -} - -=pod - -=item C - -Notifies the system that filetypes have changed. - -=cut - -sub update_assocs() { - use constant SHCNE_ASSOCCHANGED => 0x8000000; - use constant SHCNF_IDLIST => 0; - my $update_fu = new Win32::API('shell32', 'SHChangeNotify', 'LIPP', 'V'); - if ($update_fu) { - debug("Notifying changes in filetypes...\n"); - $update_fu->Call (SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0); - debug("Done notifying\n"); - } else { - debug("No update_fu\n"); - } -} - -=pod - -=back - -=head2 SHORTCUTS - -=cut - -# short path names - -my $shortfu; -if ($^O=~/^MSWin(32|64)$/i) { - $shortfu = new Win32::API('kernel32', 'GetShortPathName', 'PPN', 'N'); -} - -sub short_name { - my ($fname) = @_; - return $fname unless $is_win; - my $buffer = (' ' x 260); - my $slength = $shortfu->Call($fname, $buffer, 260); - if ($slength>0) { return substr $buffer, 0, $slength; } - else { return ''; } -} - -=pod - -=over 4 - -=item C - -Location of shell `special folders'; $user_name is the name -to look for in user mode, $admin_name is the name for admin mode, -e.g. `Desktop' and `Common Desktop'. The default for $admin_name is -'Common .$user_name - -=cut - -sub shell_folder { - my ($user_name, $admin_name) = @_; - $admin_name = 'Common '.$user_name unless ($admin_name or !$user_name); - my ($shell_key, $sh_folder); - if (admin()) { - return 0 unless $admin_name; - $shell_key = $Registry->Open( - "LMachine/software/microsoft/windows/currentversion/explorer/user shell folders/", - {Access => KEY_READ}) or return 0; - $sh_folder = $shell_key -> {"/$admin_name"}; - $sh_folder = short_name(expand_string($sh_folder)); - } else { - $shell_key = $Registry->Open( - "CUser/software/microsoft/windows/currentversion/explorer/user shell folders/", - {Access => KEY_READ}) or return 0; - $sh_folder = $shell_key -> {"/$user_name"}; - $sh_folder = short_name(expand_string($sh_folder)); - } - $sh_folder =~ s!\\!/!g; - return $sh_folder; -} - -sub desktop_path() { - return shell_folder('Desktop'); -} - -sub menu_path() { - return shell_folder('Programs', 'Common Programs'); -} - -=pod - -=item C - -Add a desktop shortcut, with name $name and icon $icon, pointing to -program $prog with parameters $args (a string). Use a non-null -batgui parameter if the shortcut starts a gui program via a -batchfile. Then the inevitable command prompt will be hidden -rightaway, leaving only the gui program visible. - -=cut - -sub add_desktop_shortcut { - my ($name, $icon, $prog, $args, $batgui) = @_; - - # create shortcut - my ($shc, $shpath, $shfile); - $shc = new Win32::Shortcut(); - $shc->{'IconLocation'} = $icon if -f $icon; - $shc->{'Path'} = $prog; - $shc->{'Arguments'} = $args; - $shc->{'ShowCmd'} = $batgui ? SW_SHOWMINNOACTIVE : SW_SHOWNORMAL; - $shfile = desktop_path().'/'.$name.'.lnk'; - $shc->Save($shfile); -} - -=pod - -=item C - -Add a menu shortcut at place $place (relative to Start/Programs), -with name $name and icon $icon, pointing to program $prog with -parameters $args. See above for batgui. - -=cut - -sub add_menu_shortcut { - my ($place, $name, $icon, $prog, $args, $batgui) = @_; - $place =~ s!\\!/!g; - - my ($shc, $shpath, $shfile); - $shc = new Win32::Shortcut(); - $shc->{'IconLocation'} = $icon if -f $icon; - $shc->{'Path'} = $prog; - $shc->{'Arguments'} = $args; - $shc->{'ShowCmd'} = $batgui ? SW_SHOWMINNOACTIVE : SW_SHOWNORMAL; - $shpath = $place; - $shpath =~ s!\\!/!g; - $shpath = '/'.$shpath unless $shpath =~ m!^/!; - $shpath = menu_path().$shpath; - if ((-e $shpath) and not (-d $shpath)) { - next; # fail silently and don't worry about it - } elsif (not (-d $shpath)) { - mkdirhier($shpath); - return unless -d $shpath; - } - $shfile = $shpath.'/'.$name.'.lnk'; - $shc->Save($shfile); -} - -=pod - -=item C - -For uninstallation of an individual package. - -=cut - -sub remove_desktop_shortcut { - my $name = shift; - unlink desktop_path().'/'.$name.'.lnk'; -} - -=pod - -=item C - -For uninstallation of an individual package. - -=cut - -sub remove_menu_shortcut { - my $place = shift; - my $name = shift; - $place =~ s!\\!/!g; - $place = '/'.$place unless $place =~ m!^/!; - unlink menu_path().$place.'/'.$name.'.lnk'; -} - -=pod - -=back - -=head2 UNINSTALLER - -=over 4 - -=item C - -Writes registry entries for add/remove programs which reference -the uninstaller script and creates uninstaller batchfiles to finish -the job. - -=cut - -sub create_uninstaller { - my ($tdfw, $tdwfw, $tdsvfw, $tdscfw) = @_; - # TEXDIR, TEXDIRW, TEXMFSYSVAR, TEXMFSYSCONFIG - $tdfw =~ s![\\/]$!!; - my $td = $tdfw; - $td =~ s!/!\\!g; - - $tdwfw =~ s![\\/]$!!; - my $tdw = $tdwfw; - $tdw =~ s!/!\\!g; - - $tdsvfw =~ s![\\/]$!!; - my $tdsv = $tdsvfw; - $tdsv =~ s!/!\\!g; - - $tdscfw =~ s![\\/]$!!; - my $tdsc = $tdscfw; - $tdsc =~ s!/!\\!g; - - my $uninst_key = $Registry -> Open((admin() ? "LMachine" : "CUser") . - "/software/microsoft/windows/currentversion/", - {Access => KEY_ALL_ACCESS()}); - my $k = $uninst_key->CreateKey( - "uninstall/TeXLive$::TeXLive::TLConfig::ReleaseYear/"); - $k->{"/DisplayName"} = "TeX Live $::TeXLive::TLConfig::ReleaseYear"; - $k->{"/UninstallString"} = "\"$tdw\\tlpkg\\installer\\uninst.bat\""; - $k->{'/DisplayVersion'} = $::TeXLive::TLConfig::ReleaseYear; - $k->{'/URLInfoAbout'} = "http://www.tug.org/texlive"; - - mkdirhier("$tdwfw/tlpkg/installer"); # wasn't this done yet? - if (open UNINST, ">$tdwfw/tlpkg/installer/uninst.bat") { - print UNINST <$tdwfw/tlpkg/installer/uninst2.bat") { - print UNINST2 <nul -del \"$tdw\\release-texlive.txt\" -set test= -for \%\%f in (\"$tdw\\*.*\") do \@set test=nonempty -if x\%test\%==x rd \"$tdw\" -\@echo Done uninstalling TeXLive. -rem \@pause -del %0 -UNEND2 -; - close UNINST2; - } else { - warn "Cannot open $tdwfw/tlpkg/installer/uninst2.bat for writing"; - } -} - -=pod - -=item C - -Removes TeXLive from Add/Remove Programs. - -=cut - -sub unregister_uninstaller { - my ($w32_multi_user) = @_; - my $regkey_uninst_path = ($w32_multi_user ? "LMachine" : "CUser") . - "/software/microsoft/windows/currentversion/uninstall/"; - my $regkey_uninst = $Registry->Open($regkey_uninst_path, - {Access => KEY_ALL_ACCESS()}); - reg_delete_recurse($regkey_uninst, "TeXLive$::TeXLive::TLConfig::ReleaseYear/") - if $regkey_uninst; -} - -=pod - -=back - -=cut - -# needs a terminal 1 for require to succeed! -1; - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/installer/install-menu-perltk-new.pl b/Master/tlpkg/installer/install-menu-perltk-new.pl deleted file mode 100644 index 6d12fff3d8b..00000000000 --- a/Master/tlpkg/installer/install-menu-perltk-new.pl +++ /dev/null @@ -1,1058 +0,0 @@ -#!/usr/bin/env perl -# $Id: install-menu-perltk.pl 20268 2010-10-31 07:26:14Z preining $ -# -# Copyright 2008, 2009, 2010 Norbert Preining -# Copyright 2008 Reinhard Kotucha -# This file is licensed under the GNU General Public License version 2 -# or any later version. -# -# TODO: -# - make the fancy selector the default, at least on unix -# - for w32 find out the necessary files for the fancy selector and move -# them to the installer perl package - -use strict; -$^W = 1; - -my $svnrev = '$Revision: 20268 $'; -$svnrev =~ m/: ([0-9]+) /; -$::menurevision = $1; - -require Tk; -require Tk::Dialog; -require Tk::DialogBox; -require Tk::PNG; -require Tk::ROText; -require Tk::ProgressBar; -require Tk::BrowseEntry; - -if ($::alternative_selector) { - require Tk::DirTree; -} - -use utf8; -no utf8; - -our %vars; -our $tlpdb; -our @collections_std; -our @collections_lang; -our @collections_lang_doc; -our $texlive_release; - -our $MENU_INSTALL = 0; -our $MENU_ABORT = 1; -our $MENU_QUIT = 2; -our $MENU_ALREADYDONE = 3; - -my $return = $MENU_INSTALL; - -our $LANG; -our %TRANS; -require("TeXLive/trans.pl"); - -$::fileassocdesc[0] = __("None"); -$::fileassocdesc[1] = __("Only new"); -$::fileassocdesc[2] = __("All"); - -$::letterdesc[0] = __('A4'); -$::letterdesc[1] = __('letter'); - -my $mw; -my $subframe; -my $mainwindow; -my $bintextbutton; -my $schemebutton; -my $tmflocalbutton; -my $tmfsysvarbutton; -my $tmfsysconfigbutton; -my $tmfhomebutton; -my $pathbutton; -my $deskintbutton; -my $assocbutton; -my $adminbutton; -my $collectionstext; -my $texmflocaltext; -my $texmfsysvartext; -my $texmfsysconfigtext; -my $texmfhometext; -my $texdirtext; -my $langcoltext; -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") ); - -$::run_menu = \&run_menu_perltk; - - -#################################################################### -# From here on only function definitions -# ################################################################## - - -sub menu_abort { - $return = $MENU_ABORT; - $mainwindow->destroy; -} - -sub setup_hooks_perltk { - @::info_hook = (); - push @::info_hook, - sub { - return unless defined $mainwindow; - update_status(join(" ",@_)); - $mainwindow->update; - }; - push @::warn_hook, - sub { - return unless defined $mainwindow ; - update_status(join(" ",@_)); - $mainwindow->update; - }; - @::install_packages_hook = (); - push @::install_packages_hook, \&update_progressbar; - push @::install_packages_hook, - sub { - return unless defined $mainwindow; - return unless defined $::sww; - $mainwindow->update; - $::sww->update; - }; -} - -sub update_status { - my ($p) = @_; - return unless defined $::progressw; - $::progressw->insert("end", "$p"); - $::progressw->see("end"); -} -sub update_progressbar { - my ($n,$total) = @_; - return unless defined $::progress; - if (defined($n) && defined($total)) { - $::progress->value(int($n*100/$total)); - } -} - - -sub run_menu_perltk { - calc_depends(); - $mainwindow = Tk::MainWindow->new; - $mainwindow->protocol('WM_DELETE_WINDOW' => \&menu_abort); - setup_hooks_perltk(); - - if (!win32()) { - require Tk::Pane; - $subframe = $mainwindow->Scrolled("Frame", -scrollbars => "oe"); - } else { - $subframe = $mainwindow->Frame; - } - $mw = $subframe->Frame; - - # image frame on the left - my $fl = $mw->Frame(-background => "#0078b8"); - my $img = $fl->Photo(-format => 'png', -file => "$::installerdir/tlpkg/installer/texlive.png"); - $fl->Label(-image => $img, -background => "#0078b8")->pack(-expand => 1, -fill => "y"); - $fl->Label(-text => "v$::installerrevision/$::menurevision", -background => "#0078b8")->pack; - - # data frame on the right - my $fr = $mw->Frame; - $fl->pack(-side => 'left', -expand => 1, -fill => "y"); - $fr->pack(-side => 'right'); - - - my $row = 1; - $fr->Label(-text => __("TeX Live %s Installation", $TeXLive::TLConfig::ReleaseYear))->grid(-row => $row, -column => 1, -columnspan => 3); - - if (!$vars{'in_place'}) { - - $row++; - $fr->Label(-text => "------- " . __("Basic Information") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); - - # binary system line - if (!win32()) { - $row++; - $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"); - } - - $row++; - - # scheme line - $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"); - - $row++; - - # further customization - $fr->Label(-text => "------- " . __("Further Customization") . " -------")->grid(-row => $row, -column => 1,-columnspan => 3); - - $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"); - - $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"); - - $row++; - $collectionstext = $fr->Label(); - $collectionstext->grid(-row => $row, -column => 1, -columnspan => 3); - } - - $row++; - # further customization - $fr->Label(-text => "------- " . __("Directory setup") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); - - $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"); - - $row++; - # texdir line - $fr->Label(-text => __('TEXDIR (the main TeX directory)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $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"); - } else { - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - } - - - $row++; - # texmflocal line - $fr->Label(-text => __('TEXMFLOCAL (directory for site-wide local files)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmflocaltext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $tmflocalbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFLOCAL"); }); - $tmflocalbutton -> grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfsysvar line - $fr->Label(-text => __('TEXMFSYSVAR (directory for autogenerated data)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfsysvartext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfsysvarbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSVAR"); }); - $tmfsysvarbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfsysconfig line - $fr->Label(-text => __('TEXMFSYSCONFIG (directory for local config)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfsysconfigtext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfsysconfigbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSCONFIG"); }); - $tmfsysconfigbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfhome line - $fr->Label(-text => __('TEXMFHOME (directory for user-specific files)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfhometext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfhomebutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFHOME"); }); - $tmfhomebutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($vars{'portable'}) { - for my $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'disabled') - } - } - - $row++; - # Options - $fr->Label(-text => "------- " . __("Options") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); - - $row++; - # 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"); - - $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"); - - $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"); - - 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"); - } - - 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"); - } - - $row++; - $fr->Label(-text => (win32()) ? __('Adjust PATH setting in registry') : - __('Create symlinks in system directories'), - -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$pathadjyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - if (unix()) { - $pathbutton = $fr->Button(-text => __("Change"), -command => sub { menu_select_symlink(); }); - } else { - $pathbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_path'}, \$pathadjyesno); }); - } - $pathbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($::opt_all_options || win32()) { - $row++; - $fr->Label(-text => __('Add shortcuts to menu and desktop'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$deskintyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $deskintbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_desktop_integration'}, \$deskintyesno); }); - $deskintbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - $fr->Label(-text => __('Change file associations'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$fileassocyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $assocbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_file_assocs(); }); - $assocbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($::opt_all_options || admin()) { - $row++; - $fr->Label(-text => __('Installation for all users'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$adminallyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $adminbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_w32_multi_user'}, \$adminallyesno); }); - $adminbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - $row++; - $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"); - } - } - if ($vars{'portable'}) { - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'disabled') if $b; - } - } - - # install/cancel buttons - my $f3 = $fr->Frame; - $f3->Button( - -text => __("Install TeX Live"), - -command => sub { installation_window(); } - )->pack(-side => 'left', -padx => "2m", -pady => "2m")->focus(); - my $quitbutton = $f3->Button( - -text => __("Quit"), - -command => \&menu_abort, - )->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $mw->bind('', [ $quitbutton, 'Invoke' ]); - #my $wizardbutton = $f3->Button( - # -text => __("Wizard"), - # -command => sub { - # $mainwindow->destroy; - # require("installer/install-menu-wizard.pl"); - # setup_hooks_wizard(); - # $return = run_menu_wizard(); - # })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $row++; - $f3->grid(-row => $row, -column => 1, -columnspan => 3); - menu_update_texts(); - $fr->gridColumnconfigure(2, -minsize => 300); - $mw->pack(-expand => 1, -fill => "both"); - $mw->update; - my $rh = $mw->reqheight; - my $rw = $mw->reqwidth; - my $maxheight = $mainwindow->screenheight() - 20; - debug("Requested height: $rh, requested width: $rw, max height: $maxheight\n"); - if ($rh > $maxheight) { - $rh = $maxheight; - $rw += 20; # for the scrollbar = = - } - $subframe->configure(-height => $rh, -width=>$rw); - $subframe->pack(-expand => 1, -fill => "both"); - $mainwindow->configure(-height => $rh, -width=>$rw); - #$mw->pack(-expand => 1, -fill => "both"); - Tk::MainLoop(); - return($return); -} - -sub installation_window { - # create a progress bar window - $::sww = $mainwindow->Toplevel(-title => __("Installation process"), - -width => 400); - $::sww->transient($mainwindow); - $::sww->grab(); - $::sww->Label(-text => __("Installation process"))->pack; - $::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 16); - $::progressw->pack(-expand => 1, -fill => "both"); - my $percent_done = 0; - $::progress = $::sww->ProgressBar(-variable => \$percent_done, - -width => 20, -length => 400, -from => 0, -to => 100, -blocks => 10, - -colors => [ 0, '#0078b8' ]); - $::progress->pack(-fill => "x"); - my $f = $::sww->Frame; - my $b = $f->Button(-text => __("Cancel"), - -command => sub { $::sww->destroy; $mainwindow->destroy; - do_cleanup(); exit(1); } - )->pack(-pady => "2m"); - $b->focus(); - $f->pack; - do_installation(); - $return = $MENU_ALREADYDONE; - my $t = __("See %s/index.html for links to documentation.\nThe TeX Live web site (http://tug.org/texlive/) contains any updates and corrections. TeX Live is a joint project of the TeX user groups around the world; please consider supporting it by joining the group best for you. The list of groups is available on the web at http://tug.org/usergroups.html.", $::vars{'TEXDIR'}); - if (!win32()) { - $t .= "\n\n" . __("Add %s/texmf/doc/man to MANPATH.\nAdd %s/texmf/doc/info to INFOPATH.\nMost importantly, add %s/bin/%s\nto your PATH for current and future sessions.", $::vars{'TEXDIR'}, $::vars{'TEXDIR'}, $::vars{'TEXDIR'}, $::vars{'this_platform'}); - } - if (@::WARNLINES) { - $t .= "\n\n" . __("There were some warnings during the installation process.\nHere is the list of warning messages:") . "\n"; - $t .= join('', @::WARNLINES); - $t =~ s/\n\z//; - } - - $t .= "\n\n" . __("Welcome to TeX Live!"); - #$t =~ s/\\n/\n/g; - $::progressw->insert("end", "\n"); - my $linechar = $::progressw->index("end"); - $::progressw->markSet("finaltext", $linechar); - $::progressw->markGravity("finaltext", "left"); - $::progressw->insert("end", "\n$t"); - $::progressw->see("end"); - $::progressw->tagAdd("centered", $linechar, "end"); - $::progressw->tagConfigure("centered", -justify => "center"); - $b->configure(-text => __("Finish"), - -command => sub { $mainwindow->destroy; }); -} - -# this sub will not be called if $vars{'in_place'} -sub menu_edit_texdir { - my $key = shift; - our $addyear = 1; - our $addtexlive = 1; - my $val = $vars{$key}; - our $currsel; - our $entry; - sub update_label { - my $t = $currsel; - $t .= "/texlive" if ($addtexlive); - $t .= "/$texlive_release" if ($addyear); - $entry->configure(-text => "$t"); - } - my $hint_var; - if ($key ne 'TEXMFHOME') { - $hint_var = win32() ? $ENV{'USERPROFILE'} : $ENV{'HOME'}; - } else { - $hint_var = win32() ? '%USERPROFILE%' : '$HOME'; - } - if ($val =~ m!^(.*)/texlive/$texlive_release$!) { - $currsel = "$1"; - $addyear = 1; - $addtexlive = 1; - } elsif ($val =~ m!^(.*)/$texlive_release$!) { - $currsel = "$1"; - $addyear = 1; - $addtexlive = 0; - } elsif ($val =~ m!^(.*)/texlive$!) { - $currsel = "$1"; - $addyear = 0; - $addtexlive = 1; - } else { - $addyear = 0; - $addtexlive = 0; - $currsel = $val; - } - my $sw = $mainwindow->Toplevel(-title => __("Change variable value")); - $sw->transient($mainwindow); - $sw->grab(); - $sw->Label(-text => __("Enter path for %s (use ~ for %s)", $key, $hint_var))->pack(-padx => "2m", -pady => "2m"); - $entry = $sw->Entry(-width => 60)->pack(-padx => "2m", -pady => "2m"); - my $f = $sw->Frame; - my $c1 = $f->Checkbutton(-text => 'Add "texlive"', -variable => \$addtexlive, - -command => \&update_label); - my $c2 = $f->Checkbutton(-text => "Add \"$texlive_release\"", -variable => \$addyear, - -command => \&update_label); - my $foo = $sw->Scrolled("DirTree", -scrollbars => "osoe", - -browsecmd => sub { my ($d) = @_; $currsel = $d; update_label(); }, - -directory => "$currsel"); - my $ff = $sw->Frame; - my $ok = $ff->Button(-text => __("Ok"), -command => sub { $val = $entry->get; callback_edit_directories($key,$val); $sw->destroy; }); - my $cancel = $ff->Button(-text => __("Cancel"), -command => sub { $sw->destroy; }); - update_label(); - $c1->pack(-side => "left", -padx => "2m", -pady => "2m"); - $c2->pack(-side => "right", -padx => "2m", -pady => "2m"); - $f->pack; - $foo->pack(-fill => "both", -expand => 1); - $ok->pack(-side => 'left' , -padx => "2m", -pady => "2m"); - $cancel->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $ff->pack; - # bindings - $sw->bind('' => [ $ok, 'Invoke']); - $sw->bind('' => [ $cancel, 'Invoke']); -} - -sub menu_edit_vars_value { - my $key = shift; - my $sw = $mainwindow->Toplevel(-title => __("Change variable value")); - $sw->transient($mainwindow); - $sw->grab(); - my $val = $vars{$key}; - my $hint_var; - if ($key ne 'TEXMFHOME') { - $hint_var = win32() ? $ENV{'USERPROFILE'} : $ENV{'HOME'}; - } else { - $hint_var = win32() ? '%USERPROFILE%' : '$HOME'; - } - $sw->Label(-text => __("Enter path for %s (use ~ for %s)", $key, $hint_var))->pack(-padx => "2m", -pady => "2m"); - my $entry = $sw->Entry(-text => native_slashify($val), -width => 60); - $entry->pack(-padx => "2m", -pady => "2m")->focus(); - my $f = $sw->Frame; - my $okbutton = $f->Button(-text => __("Ok"), - -command => sub { $val = forward_slashify($entry->get); callback_edit_directories($key,$val) ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $f->pack(-expand => 'x'); - # bindings - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - -sub menu_edit_file_assocs { - my $sw = $mainwindow->Toplevel(-title => __('Change file associations')); - $sw->transient($mainwindow); - $sw->grab(); - my $key = 'option_file_assocs'; - my $var = $::fileassocdesc[$vars{$key}]; - $sw->Label(-text => __("Change file associations"))->pack(-padx => "2m", -pady => "2m"); - my $opt = $sw->BrowseEntry(-autolistwidth => 1, - -variable => \$var); - for my $i (0..2) { - $opt->insert("end", $::fileassocdesc[$i]); - } - - $opt->pack(-padx => "2m", -pady => "2m")->focus(); - my $f = $sw->Frame; - my $okbutton = $f->Button(-text => __("Ok"), - -command => sub { - my $idx; - if ($var eq $::fileassocdesc[0]) { - $idx = 0; - } elsif ($var eq $::fileassocdesc[1]) { - $idx = 1; - } elsif ($var eq $::fileassocdesc[2]) { - $idx = 2; - } else { - die "How that could happen!\n"; - } - $vars{$key} = $idx; - $fileassocyesno = $::fileassocdesc[$idx]; - $sw->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); - my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $sw->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); - $f->pack; - $sw->bind('', [ $okbutton, 'Invoke' ]); - $sw->bind('', [ $cancelbutton, 'Invoke' ]); -} - - -sub menu_select_scheme { - my $sw = $mainwindow->Toplevel(-title => __('Selected scheme')); - $sw->transient($mainwindow); - $sw->grab(); - my @schemes; - foreach my $pkg ($tlpdb->list_packages) { - my $tlpobj = $tlpdb->{'tlps'}{$pkg}; - if ($tlpobj->category eq "Scheme") { - push @schemes, $pkg; - $vars{"$pkg"}=($vars{'selected_scheme'} eq $pkg)? 1:0; - } - } - @schemes=sort @schemes; - push @schemes, "scheme-custom"; - my $selected = $vars{'selected_scheme'}; - $sw->Label(-text => __("Selected scheme"))->pack(-padx => "2m", -pady => "2m"); - my $f2 = $sw->Frame; - my $f2l = $f2->Frame; - my $f2r = $f2->Frame; - my $nrfh = $#schemes / 2; - my $i = 0; - foreach my $scheme (@schemes) { - my $desc; - if ($scheme ne "scheme-custom") { - my $tlpobj = $tlpdb->get_package("$scheme"); - $desc = $tlpobj->shortdesc; - } else { - $desc = "custom selection of collections"; - } - my $b; - if ($i < $nrfh) { - $b = $f2l->Radiobutton(-variable => \$selected, -value => $scheme, - -text => __($desc))->pack(-anchor => 'w'); - } else { - $b = $f2r->Radiobutton(-variable => \$selected, -value => $scheme, - -text => __($desc))->pack(-anchor => 'w'); - } - if ($selected eq $scheme) { - $b->focus(); - } - $i++; - } - $f2l->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f2r->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $f2->pack; - my $f3 = $sw->Frame; - my $okbutton = $f3->Button(-text => __("Ok"), - -command => sub { callback_select_scheme($selected) ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f3->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f3->pack(-expand => 'x'); - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_standard_collections { - my $sw = $mainwindow->Toplevel(-title => __('Standard collections')); - $sw->transient($mainwindow); - $sw->grab(); - my $fb = $sw->Frame; - my $fc = $sw->Frame; - my $fd = $sw->Frame; - my $f1 = $fb->Frame; - my $f2 = $fb->Frame; - my %lvars = %vars; - $sw->Label(-text => __("Select the collections to be installed"))->pack(-padx => "2m", -pady => "2m"); - my $halfcol = $#collections_std / 2; - my $i = 0; - foreach my $coll (sort @collections_std) { - my $tlpobj = $tlpdb->get_package("$coll"); - if ($i < $halfcol) { - $f1->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } else { - $f2->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } - $i++; - } - $f1->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f2->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $fb->pack(-padx => "2m", -pady => "2m"); - $fc->pack(); - $fc->Button(-text => __("Select All"), - -command => sub { select_collections(\%lvars, @collections_std) })->pack(-side => 'left', -padx => "2m", -pady => "2m")->focus(); - $fc->Button(-text => __("Deselect All"), - -command => sub { deselect_collections(\%lvars, @collections_std) })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $fd->pack(-expand => 'x', -padx => "2m", -pady => "2m"); - my $okbutton = $fd->Button(-text => __("Ok"), - -command => sub { - # we call the update only if something has changed - my $changed = 0; - for my $k (keys %lvars) { - if ($vars{$k} ne $lvars{$k}) { - $changed = 1; - last; - } - } - if ($changed) { - %vars = %lvars; - callback_select_collection(); - } - $sw->destroy; - })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $fd->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_lang_collections { - my $sw = $mainwindow->Toplevel(-title => __('Language collections')); - $sw->transient($mainwindow); - $sw->grab(); - my $f1 = $sw->Frame; - $f1->pack; - my $f1lang = $f1->Labelframe(-text => __("Select language support")); - my $f1doc = $f1->Labelframe(-text => __("Select language-specific documentation")); - $f1lang->pack(-side => 'left', -padx => "2m", -pady => "2m", -ipadx => "2m", -ipady => "2m"); - $f1doc->pack(-side => 'right', -padx => "2m", -pady => "2m", -ipadx => "2m", -ipady => "2m", -expand => 1, -fill => "y"); - my $f1langT = $f1lang->Frame; $f1langT->pack; - my $f1langL = $f1lang->Frame; $f1langL->pack; - my $f1langLa = $f1langL->Frame; $f1langLa->pack(-side => 'left'); - my $f1langLb = $f1langL->Frame; $f1langLb->pack(-side => 'right'); - my $langh = $#collections_lang / 2; - my $i = 0; - my %lvars = %vars; - foreach my $coll (sort @collections_lang) { - my $tlpobj = $tlpdb->get_package("$coll"); - if ($i < $langh) { - $f1langLa->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } else { - $f1langLb->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } - $i++; - } - my $f1langB = $f1lang->Frame; - $f1langB->pack(-expand => 'x'); - $f1langB->Button(-text => __("Select All"), - -command => sub { select_collections(\%lvars, @collections_lang) })->pack(-side => 'left', -padx => "2m", -pady => "2m")->focus(); - $f1langB->Button(-text => __("Deselect All"), - -command => sub { deselect_collections(\%lvars, @collections_lang) })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - - my $f1docT = $f1doc->Frame; $f1docT->pack; - my $f1docL = $f1doc->Frame; $f1docL->pack; - my $f1docLa = $f1docL->Frame; $f1docLa->pack(-side => 'left'); - my $f1docLb = $f1docL->Frame; $f1docLb->pack(-side => 'right'); - my $doch = $#collections_lang_doc / 2; - $i = 0; - foreach my $coll (sort @collections_lang_doc) { - my $tlpobj = $tlpdb->get_package("$coll"); - if ($i < $doch) { - $f1docLa->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } else { - $f1docLb->Checkbutton(-variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc))->pack(-anchor => 'w'); - } - $i++; - } - my $f1docB = $f1doc->Frame; - $f1docB->pack(-expand => 1, -side => "bottom"); - $f1docB->Button(-text => __("Select All"), - -command => sub { select_collections(\%lvars, @collections_lang_doc) })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f1docB->Button(-text => __("Deselect All"), - -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 => __("Ok"), - -command => sub { - # we call the update only if something has changed - my $changed = 0; - for my $k (keys %lvars) { - if ($vars{$k} ne $lvars{$k}) { - $changed = 1; - last; - } - } - if ($changed) { - %vars = %lvars; - callback_select_collection(); - } - $sw->destroy; - })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f2->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_symlink { - our ($lbin,$lman,$linfo); - our $osym = $vars{'option_path'}; - our ($binlab,$binb,$manlab,$manb,$infolab,$infob); - sub set_unset_buttons { - $lbin = ($osym ? $vars{'option_sys_bin'} : ''); - $linfo = ($osym ? $vars{'option_sys_info'} : ''); - $lman = ($osym ? $vars{'option_sys_man'} : ''); - if ($osym) { - $binb->configure (-state => 'normal'); - $manb->configure (-state => 'normal'); - $infob->configure(-state => 'normal'); - } else { - $infob->configure(-state => 'disabled'); - $manb->configure (-state => 'disabled'); - $binb->configure (-state => 'disabled'); - } - } - sub return_callback { - if ($osym) { - my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if (win32()); - $home ||= '~'; - $lbin =~ s/^~/$home/; - $linfo =~ s/^~/$home/; - $lman =~ s/^~/$home/; - $vars{'option_sys_bin'} = $lbin; - $vars{'option_sys_info'} = $linfo; - $vars{'option_sys_man'} = $lman; - } - $vars{'option_path'} = $osym; - toggle_and_set_opt_variable(\$vars{'option_path'}, \$pathadjyesno); - } - my $sw = $mainwindow->Toplevel(-title => __('Create symlinks in system directories')); - $sw->transient($mainwindow); - $sw->grab(); - $sw->Checkbutton(-variable => \$osym, - -text => __("create symlinks in standard directories"), - -command => sub { set_unset_buttons(); } )->grid(-column => 1, - -row => 1, - -columnspan => 2, - -padx => "2m"); - $binlab = $sw->Label(-text => __("binaries to")); - $binb = $sw->Entry(-textvariable => \$lbin); - $manlab = $sw->Label(-text => __("manpages to")); - $manb = $sw->Entry(-textvariable => \$lman); - $infolab = $sw->Label(-text => __("info to")); - $infob = $sw->Entry(-textvariable => \$linfo); - $binlab->grid(-row => 2, -column => 1, -sticky => "w", -padx => "2m"); - $binb->grid(-row => 2, -column => 2, -sticky => "ew", -padx => "2m"); - $manlab->grid(-row => 3, -column => 1, -sticky => "w", -padx => "2m"); - $manb->grid(-row => 3, -column => 2, -sticky => "ew", -padx => "2m"); - $infolab->grid(-row => 4, -column => 1, -sticky => "w", -padx => "2m"); - $infob->grid(-row => 4, -column => 2, -sticky => "ew", -padx => "2m"); - set_unset_buttons(); - my $f2 = $sw->Frame; $f2->grid(-column => 1, -columnspan => 2, -row => 5); - my $okbutton = $f2->Button(-text => __("Ok"), - -command => sub { return_callback(); $sw->destroy })->pack(-side => 'left'); - my $cancelbutton = $f2->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right'); - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_binsystems { - my $f2r; - my $f2; - my $sw = $mainwindow->Toplevel(-title => __('Binary system(s)')); - $sw->transient($mainwindow); - $sw->grab(); - my @diskarchs = (); - foreach my $key (keys %vars) { - if ($key=~/binary_(.*)/) { - push @diskarchs, $1; - } - } - $sw->Label(-text => __("Select arch-os"))->pack(-padx => "2m", -pady => "2m"); - $f2 = $sw->Frame; - my $f2l = $f2->Frame; - foreach my $sys (sort @diskarchs) { - $f2l->Checkbutton(-variable => \$vars{"binary_$sys"}, -text => platform_desc($sys))->pack(-anchor => 'w'); - } - $f2l->pack(-side => 'left'); - $f2->pack(-padx => "2m", -pady => "2m"); - my $f3 = $sw->Frame; - my $okbutton = $f3->Button(-text => __("Ok"), - -command => sub { callback_select_systems() ; $sw->destroy })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f3->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $f3->pack(-expand => 'x'); - $sw->bind('' => [ $okbutton, 'Invoke']); - $sw->bind('' => [ $cancelbutton, 'Invoke']); -} - - -sub menu_set_text { - my $w = shift; - my $t = shift; - # if in_place or portable not a complete interface - $w->configure(-text => $t, @_) if $w; -} - -sub menu_set_schemebutton_text { - menu_set_text($schemebutton, "$vars{'selected_scheme'}"); -} - -sub menu_set_binbutton_text { - if (!win32()) { - menu_set_text($bintextbutton, __("%s out of %s", $vars{'n_systems_selected'}, $vars{'n_systems_available'})); - } -} - -sub menu_set_collections_text { - menu_set_text($collectionstext, __("%s collections out of %s", - $vars{'n_collections_selected'}, $vars{'n_collections_available'}) - . " (" . __("disk space required:") . " $vars{'total_size'} MB)"); -} - -sub menu_set_pathes_text { - if (check_on_lang_collection_installed()) { - # good - menu_set_text($langcoltext, ""); - } else { - # bad - menu_set_text($langcoltext, __("(no language collection selected!)"), -foreground => "red"); - } - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text($texdirtext, native_slashify($vars{'TEXDIR'}), -foreground => "black"); - } else { - menu_set_text($texdirtext, __("(default not writable - please change!)"), -foreground => "red"); - } - menu_set_text($texmflocaltext, native_slashify($vars{'TEXMFLOCAL'})); - if ((-w $vars{'TEXMFSYSVAR'}) || (-w dirname($vars{'TEXMFSYSVAR'}))) { - menu_set_text($texmfsysvartext, native_slashify($vars{'TEXMFSYSVAR'}), -foreground => "black"); - } elsif ("$vars{'TEXMFSYSVAR'}" =~ m;^$vars{'TEXDIR'};) { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text($texmfsysvartext, native_slashify($vars{'TEXMFSYSVAR'}), -foreground => "black"); - } else { - menu_set_text($texmfsysvartext, __("(please change TEXDIR first!)"), -foreground => "red"); - } - } else { - menu_set_text($texmfsysvartext, __("(default not writable - please change!)")); - } - if ((-w $vars{'TEXMFSYSCONFIG'}) || (-w dirname($vars{'TEXMFSYSCONFIG'}))) { - menu_set_text($texmfsysconfigtext, native_slashify($vars{'TEXMFSYSCONFIG'}), -foreground => "black"); - } elsif ("$vars{'TEXMFSYSCONFIG'}" =~ m;^$vars{'TEXDIR'};) { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text($texmfsysconfigtext, native_slashify($vars{'TEXMFSYSCONFIG'}), -foreground => "black"); - } else { - menu_set_text($texmfsysconfigtext, __("(please change TEXDIR first!)"), -foreground => "red"); - } - } else { - menu_set_text($texmfsysconfigtext, __("(default not writable - please change!)")); - } - menu_set_text($texmfhometext, native_slashify($vars{'TEXMFHOME'})); -} - - -sub menu_update_texts { - menu_set_pathes_text; - menu_set_collections_text; - menu_set_binbutton_text; - menu_set_schemebutton_text; - $optletterstate = $::letterdesc[$vars{'option_letter'}]; - $optfmtstate = ($vars{'option_fmt'} ? __("Yes") : __("No")); - $optsrcstate = ($vars{'option_src'} ? __("Yes") : __("No")); - $optdocstate = ($vars{'option_doc'} ? __("Yes") : __("No")); -} - -sub callback_select_scheme { - my $s = shift; - select_scheme($s); - $editoryesno = ($vars{'collection-texworks'} ? __("Yes") : __("No")); - menu_update_texts(); -} - -sub callback_select_collection { - # special case for collection-texworks: - $editoryesno = ($vars{'collection-texworks'} ? __("Yes") : __("No")); - calc_depends(); - select_scheme("scheme-custom"); - update_numbers(); - menu_update_texts(); -} - -sub callback_select_systems() { - if ($vars{"binary_win32"}) { - $vars{"collection-wintools"} = 1; - } else { - $vars{"collection-wintools"} = 0; - } - calc_depends(); - update_numbers(); - menu_update_texts(); -} - -sub callback_edit_directories { - my ($key,$val) = @_; - my $home = getenv('HOME'); - if (win32()) { - $home = getenv('USERPROFILE'); - $home =~ s!\\!/!g; - } - $home ||= '~'; - $val =~ s!\\!/!g; - $vars{$key} = $val; - $vars{'TEXDIR'} =~ s/^~/$home/; - $vars{'TEXMFLOCAL'} =~ s/^~/$home/; - $vars{'TEXMFSYSVAR'} =~ s/^~/$home/; - $vars{'TEXMFSYSCONFIG'} =~ s/^~/$home/; - # only if we set TEXDIR we set the others in parallel - my $texdirnoslash; - if ($key eq "TEXDIR") { - if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { - $texdirnoslash = $1; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/$texlive_release/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/$texlive_release/texmf-config"; - } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { - $texdirnoslash = $1; - $texdirnoslash =~ s!/$!!; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/texmf-config"; - } - $vars{'TEXDIRW'}=$vars{'TEXDIR'} - } - menu_update_texts(); -} - -sub callback_edit_var() { - my ($key,$val) = @_; - $vars{$key} = $val; - menu_update_texts(); -} - -sub dump_vars_stdout { - foreach my $k (keys %vars) { - print "DEBUG: vars{$k} = $vars{$k}\n"; - } -} - -sub toggle_portable { - my $td = $vars{'TEXDIR'}; - my $b; - if ($vars{'portable'}) { - $vars{'portable'} = 0; - $portableyesno = __('No'); - # enable some buttons - for $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'normal'); - } - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'normal') if $b; - } - } else { - $vars{'portable'} = 1; - $portableyesno = __('Yes'); - # disable some buttons. These should get a name first. - for $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'disabled'); - } - $vars{'option_path'} = 0; - $vars{'option_desktop_integration'} = 0; - $vars{'option_file_assocs'} = 0; - $vars{'option_w32_multi_user'} = 0; - $deskintyesno = __("No"); - $pathadjyesno = __("No"); - $fileassocyesno = __("None"); - $adminallyesno = __("No"); - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'disabled') if $b; - } - } - set_texlive_default_dirs(); # this sub tests for portable and in_place - menu_set_pathes_text(); - # same for some options -} - -sub toggle_and_set_opt_variable { - my ($varsref, $toggleref, $choicesref) = @_; - my ($no, $yes) = $choicesref ? @$choicesref : (__('No'), __('Yes')); - $$toggleref = ($$toggleref eq $yes) ? $no : $yes; - $$varsref = 0; - $$varsref = 1 if ($$toggleref eq $yes); - calc_depends(); - menu_update_texts(); -} - -1; - -__END__ - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/installer/install-menu-perltk.pl b/Master/tlpkg/installer/install-menu-perltk.pl index 343eca2f52b..7f17d1d6d1b 100644 --- a/Master/tlpkg/installer/install-menu-perltk.pl +++ b/Master/tlpkg/installer/install-menu-perltk.pl @@ -63,6 +63,14 @@ my $subframe; my $mainwindow; my $bintextbutton; my $schemebutton; +my $tmflocalbutton; +my $tmfsysvarbutton; +my $tmfsysconfigbutton; +my $tmfhomebutton; +my $pathbutton; +my $deskintbutton; +my $assocbutton; +my $adminbutton; my $collectionstext; my $texmflocaltext; my $texmfsysvartext; @@ -74,6 +82,7 @@ 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") ); @@ -115,11 +124,11 @@ sub setup_hooks_perltk { @::install_packages_hook = (); push @::install_packages_hook, \&update_progressbar; push @::install_packages_hook, - sub { + sub { return unless defined $mainwindow; return unless defined $::sww; - $mainwindow->update; - $::sww->update; + $mainwindow->update; + $::sww->update; }; } @@ -167,59 +176,68 @@ sub run_menu_perltk { my $row = 1; $fr->Label(-text => __("TeX Live %s Installation", $TeXLive::TLConfig::ReleaseYear))->grid(-row => $row, -column => 1, -columnspan => 3); - $row++; - $fr->Label(-text => "------- " . __("Basic Information") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); - + if (!$vars{'in_place'}) { - # binary system line - if (!win32()) { $row++; - $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"); - } + $fr->Label(-text => "------- " . __("Basic Information") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); - $row++; + # binary system line + if (!win32()) { + $row++; + $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"); + } - # scheme line - $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"); + $row++; - $row++; + # scheme line + $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"); - # further customization - $fr->Label(-text => "------- " . __("Further Customization") . " -------")->grid(-row => $row, -column => 1,-columnspan => 3); + $row++; - $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"); + # further customization + $fr->Label(-text => "------- " . __("Further Customization") . " -------")->grid(-row => $row, -column => 1,-columnspan => 3); - $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"); + $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"); - $row++; - $collectionstext = $fr->Label(); - $collectionstext->grid(-row => $row, -column => 1, -columnspan => 3); + $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"); + + $row++; + $collectionstext = $fr->Label(); + $collectionstext->grid(-row => $row, -column => 1, -columnspan => 3); + } $row++; # further customization $fr->Label(-text => "------- " . __("Directory setup") . " -------")->grid(-row => $row, -column => 1, -columnspan => 3); + $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"); + $row++; # texdir line $fr->Label(-text => __('TEXDIR (the main TeX directory)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $texdirtext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - if ($::alternative_selector) { - $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"); + 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"); + } else { + $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXDIR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + } } @@ -227,25 +245,35 @@ sub run_menu_perltk { # texmflocal line $fr->Label(-text => __('TEXMFLOCAL (directory for site-wide local files)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $texmflocaltext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFLOCAL"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $tmflocalbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFLOCAL"); }); + $tmflocalbutton -> grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; # texmfsysvar line $fr->Label(-text => __('TEXMFSYSVAR (directory for autogenerated data)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $texmfsysvartext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSVAR"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $tmfsysvarbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSVAR"); }); + $tmfsysvarbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; - # texmfsysvar line + # texmfsysconfig line $fr->Label(-text => __('TEXMFSYSCONFIG (directory for local config)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $texmfsysconfigtext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSCONFIG"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $tmfsysconfigbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFSYSCONFIG"); }); + $tmfsysconfigbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; # texmfhome line $fr->Label(-text => __('TEXMFHOME (directory for user-specific files)'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $texmfhometext = $fr->Label(-anchor => 'w')->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFHOME"); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $tmfhomebutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_vars_value("TEXMFHOME"); }); + $tmfhomebutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + + if ($vars{'portable'}) { + for my $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { + $b->configure(-state => 'disabled') + } + } $row++; # Options @@ -267,14 +295,14 @@ sub run_menu_perltk { $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"); - if ($vars{'doc_splitting_supported'}) { + 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"); } - if ($vars{'src_splitting_supported'}) { + 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"); @@ -282,38 +310,49 @@ sub run_menu_perltk { } $row++; - $fr->Label(-text => (win32()) ? __('Adjust PATH setting in registry') : + $fr->Label(-text => (win32()) ? __('Adjust PATH setting in registry') : __('Create symlinks in system directories'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$pathadjyesno)->grid(-row => $row, -column => 2, -padx => "2m"); if (unix()) { - $fr->Button(-text => __("Change"), -command => sub { menu_select_symlink(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $pathbutton = $fr->Button(-text => __("Change"), -command => sub { menu_select_symlink(); }); } else { - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_path'}, \$pathadjyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $pathbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_path'}, \$pathadjyesno); }); } + $pathbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); if ($::opt_all_options || win32()) { $row++; $fr->Label(-text => __('Add shortcuts to menu and desktop'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$deskintyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_desktop_integration'}, \$deskintyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $deskintbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_desktop_integration'}, \$deskintyesno); }); + $deskintbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); $row++; $fr->Label(-text => __('Change file associations'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$fileassocyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Change"), -command => sub { menu_edit_file_assocs(); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $assocbutton = $fr->Button(-text => __("Change"), -command => sub { menu_edit_file_assocs(); }); + $assocbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); if ($::opt_all_options || admin()) { $row++; $fr->Label(-text => __('Installation for all users'), -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); $fr->Label(-anchor => 'w', -textvariable => \$adminallyesno)->grid(-row => $row, -column => 2, -padx => "2m"); - $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_w32_multi_user'}, \$adminallyesno); })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); + $adminbutton = $fr->Button(-text => __("Toggle"), -command => sub { toggle_and_set_opt_variable(\$vars{'option_w32_multi_user'}, \$adminallyesno); }); + $adminbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); } $row++; $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"); - $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{'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"); + } + } + if ($vars{'portable'}) { + for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { + $b->configure(-state => 'disabled') if $b; + } } # install/cancel buttons @@ -330,7 +369,7 @@ sub run_menu_perltk { #my $wizardbutton = $f3->Button( # -text => __("Wizard"), # -command => sub { - # $mainwindow->destroy; + # $mainwindow->destroy; # require("installer/install-menu-wizard.pl"); # setup_hooks_wizard(); # $return = run_menu_wizard(); @@ -404,6 +443,7 @@ sub installation_window { -command => sub { $mainwindow->destroy; }); } +# this sub will not be called if $vars{'in_place'} sub menu_edit_texdir { my $key = shift; our $addyear = 1; @@ -511,7 +551,7 @@ sub menu_edit_file_assocs { $opt->pack(-padx => "2m", -pady => "2m")->focus(); my $f = $sw->Frame; my $okbutton = $f->Button(-text => __("Ok"), - -command => sub { + -command => sub { my $idx; if ($var eq $::fileassocdesc[0]) { $idx = 0; @@ -522,8 +562,8 @@ sub menu_edit_file_assocs { } else { die "How that could happen!\n"; } - $vars{$key} = $idx; - $fileassocyesno = $::fileassocdesc[$idx]; + $vars{$key} = $idx; + $fileassocyesno = $::fileassocdesc[$idx]; $sw->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $sw->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); $f->pack; @@ -619,7 +659,7 @@ sub menu_select_standard_collections { -command => sub { deselect_collections(\%lvars, @collections_std) })->pack(-side => 'right', -padx => "2m", -pady => "2m"); $fd->pack(-expand => 'x', -padx => "2m", -pady => "2m"); my $okbutton = $fd->Button(-text => __("Ok"), - -command => sub { + -command => sub { # we call the update only if something has changed my $changed = 0; for my $k (keys %lvars) { @@ -629,8 +669,8 @@ sub menu_select_standard_collections { } } if ($changed) { - %vars = %lvars; - callback_select_collection(); + %vars = %lvars; + callback_select_collection(); } $sw->destroy; })->pack(-side => 'left', -padx => "2m", -pady => "2m"); @@ -706,8 +746,8 @@ sub menu_select_lang_collections { } } if ($changed) { - %vars = %lvars; - callback_select_collection(); + %vars = %lvars; + callback_select_collection(); } $sw->destroy; })->pack(-side => 'left', -padx => "2m", -pady => "2m"); @@ -815,7 +855,8 @@ sub menu_select_binsystems { sub menu_set_text { my $w = shift; my $t = shift; - $w->configure(-text => $t, @_); + # if in_place or portable not a complete interface + $w->configure(-text => $t, @_) if $w; } sub menu_set_schemebutton_text { @@ -927,15 +968,19 @@ sub callback_edit_directories { $vars{'TEXMFSYSVAR'} =~ s/^~/$home/; $vars{'TEXMFSYSCONFIG'} =~ s/^~/$home/; # only if we set TEXDIR we set the others in parallel + my $texdirnoslash; if ($key eq "TEXDIR") { if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { - $vars{'TEXMFLOCAL'}="$1/texmf-local"; - $vars{'TEXMFSYSVAR'}="$1/$texlive_release/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$1/$texlive_release/texmf-config"; + $texdirnoslash = $1; + $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; + $vars{'TEXMFSYSVAR'}="$texdirnoslash/$texlive_release/texmf-var"; + $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/$texlive_release/texmf-config"; } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { - $vars{'TEXMFLOCAL'}="$1/texmf-local"; - $vars{'TEXMFSYSVAR'}="$1/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$1/texmf-config"; + $texdirnoslash = $1; + $texdirnoslash =~ s!/$!!; + $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; + $vars{'TEXMFSYSVAR'}="$texdirnoslash/texmf-var"; + $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/texmf-config"; } $vars{'TEXDIRW'}=$vars{'TEXDIR'} } @@ -954,6 +999,43 @@ sub dump_vars_stdout { } } +sub toggle_portable { + my $td = $vars{'TEXDIR'}; + my $b; + if ($vars{'portable'}) { + $vars{'portable'} = 0; + $portableyesno = __('No'); + # enable some buttons + for $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { + $b->configure(-state => 'normal'); + } + for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { + $b->configure(-state => 'normal') if $b; + } + } else { + $vars{'portable'} = 1; + $portableyesno = __('Yes'); + # disable some buttons. These should get a name first. + for $b ($tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { + $b->configure(-state => 'disabled'); + } + $vars{'option_path'} = 0; + $vars{'option_desktop_integration'} = 0; + $vars{'option_file_assocs'} = 0; + $vars{'option_w32_multi_user'} = 0; + $deskintyesno = __("No"); + $pathadjyesno = __("No"); + $fileassocyesno = __("None"); + $adminallyesno = __("No"); + for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { + $b->configure(-state => 'disabled') if $b; + } + } + set_texlive_default_dirs(); # this sub tests for portable and in_place + menu_set_pathes_text(); + # same for some options +} + sub toggle_and_set_opt_variable { my ($varsref, $toggleref, $choicesref) = @_; my ($no, $yes) = $choicesref ? @$choicesref : (__('No'), __('Yes')); diff --git a/Master/tlpkg/installer/install-menu-text-new.pl b/Master/tlpkg/installer/install-menu-text-new.pl deleted file mode 100755 index a9c5cad4499..00000000000 --- a/Master/tlpkg/installer/install-menu-text-new.pl +++ /dev/null @@ -1,1073 +0,0 @@ -#!/usr/bin/env perl -# $Id: install-menu-text.pl 20268 2010-10-31 07:26:14Z preining $ -# install-menu-txt.pl -# -# Copyright 2007, 2008, 2009, 2010 Norbert Preining, Karl Berry -# Copyright 2007, 2008 Reinhard Kotucha -# This file is licensed under the GNU General Public License version 2 -# or any later version. -# -# This file implements the text based menu system for the TeX Live installer. - -use vars qw(@::end_install_hook $::opt_no_cls); - -our %vars; -our $tlpdb; -our @media_available; -our $previoustlpdb; -our @collections_std; -our @collections_lang; -our @collections_lang_doc; -our $texlive_release; - -my $MENU_CONTINUE = -1; -our $MENU_INSTALL = 0; -our $MENU_ABORT = 1; -our $MENU_QUIT = 2; - - -my $RETURN = $MENU_CONTINUE; - -# issue welcome message on end of installation -push @::end_install_hook, - sub { if (win32()) { print TeXLive::TLUtils::welcome(); } - else { print TeXLive::TLUtils::welcome_paths(); } }; - -sub clear_screen { - return 0 if ($::opt_no_cls); - system (unix() ? 'clear' : 'cls'); -} - -sub string_to_list { - my $string=shift; - return split(//, $string); -} - -sub button { - my $val=shift; - return ($val)? '[X]':'[ ]'; -} - -sub hbar { - return '=' x79, "\n"; -} - -sub toggle { - my $var=shift; - $vars{$var} = ($vars{$var} ? 0 : 1); -} - -sub menu_head { - my $text = shift; - clear_screen; - print hbar(), "$text\n\n"; -} - -sub other_options { - my @options=@_; - my %opts=( - '-' => 'deselect all', - '+' => 'select all', - 'H' => 'help', - 'R' => 'return to main menu', - 'Q' => 'quit' - ); - - $opts{'I'}=$vars{'portable'} ? 'start portable installation' : - 'start installation to hard disk'; - - print "\nActions:"; - if ($options[$#options] eq 'diskspace') { - pop @options; - calc_depends (); - print " (disk space required: $vars{'total_size'} MB)"; - } - print "\n"; - - for my $option (@options) { - if (defined $opts{"$option"}) { - printf " <%s> %s\n", $option, $opts{$option}; - } else { - die "other_options: $opts{$option} undefined.\n"; - } - } -} - -sub prompt { - my $prompt = shift; - print "\n$prompt: "; - my $answer = ; - $answer = "q" if !defined($answer); - chomp($answer); - return "$answer"; -} - -# The menu loop. A menu is a function. Its return value is a -# reference to another menu or to itself. -sub run_menu_text { - my (@args) = @_; - # the text mode installer does not take interest in any argument - # but the -old-installation-found - while (@args) { - my $f = shift @args; - if ($f =~ m/^-old-installation-found=(.*)$/) { - my $dn = $1; - print "\nAn old installation of TeX Live has been found in $dn\n"; - print " -If you want the selection of collections and various options being taken -over press `y', otherwise anything else. - -Import settings from previous TeX Live installation: (y/n): "; - chomp(my $yn = ); - if ($yn =~ m/^y$/i) { - import_settings_from_old_tlpdb($dn); - } - } - } - my $menu=\&main_menu; - while ($RETURN == $MENU_CONTINUE) { - $menu=$menu->(); - } - return($RETURN); -} -$::run_menu = \&run_menu_text; - -sub binary_menu { - my %command=( - 'self' => \&binary_menu, - 'R' => \&main_menu, - 'Q' => \&quit - ); - - my @binaries; - my @keys=string_to_list "abcdefghijklmopstuvwxyz"; - my $index=0; - my %keyval; - my $selected_platform; - - menu_head "Available platforms:"; - - foreach my $key (keys %vars) { - if ($key =~ /binary_(.*)/) { - push @binaries, $1; - } - } - @binaries=sort(@binaries); - - foreach my $binary (@binaries) { - printf " %s %s %-16s %s\n", $keys[$index], - button($vars{"binary_$binary"}), - "$binary", - platform_desc($binary); - $keyval{"$keys[$index]"} = "binary_$binary"; - ++$index; - } - other_options qw(- + R Q diskspace); - - my $answer = prompt 'Enter letter(s) to select platforms'; - - my @keystrokes=string_to_list $answer; - - foreach my $keystroke (@keystrokes) { - if ($keystroke eq '-') { - for my $binary (@binaries) { - $vars{"binary_$binary"}=0 if defined $vars{"binary_$binary"}; - } - } - if ($keystroke eq '+') { - for my $binary (@binaries) { - $vars{"binary_$binary"}=1 if defined $vars{"binary_$binary"}; - } - } - if (defined $keyval{$keystroke}) { - toggle "$keyval{$keystroke}"; - } elsif (!defined $command{"\u$answer"}) { - print "Unknown command: $keystroke\n\n"; - } - } - if ($vars{"binary_win32"}) { - $vars{"collection-wintools"} = 1; - } else { - $vars{"collection-wintools"} = 0; - } - if (defined $command{"\u$answer"}) { - return $command{"\u$answer"}->(); - } else { - return $command{'self'}->(); - } -} - - -sub scheme_menu { - my %command=( - 'self' => \&scheme_menu, - 'R' => \&main_menu, - 'Q' => \&quit - ); - - my @schemes; - my @keys=string_to_list "abcdefghijklmnopstuvwxyz"; - my %keyval; - my $index=0; - - menu_head 'Select scheme:'; - - foreach my $pkg ($tlpdb->schemes) { - push @schemes, $pkg; - $vars{"$pkg"}=($vars{'selected_scheme'} eq $pkg)? 1:0; - } - @schemes=sort @schemes; - push @schemes, "scheme-custom"; - - foreach my $scheme (@schemes) { - $keyval{$keys[$index]}="$scheme"; - if ($scheme ne "scheme-custom") { - my $tlpobj = $tlpdb->get_package("$scheme"); - printf " %s %s %s\n", $keys[$index], button($vars{"$scheme"}), - $tlpobj->shortdesc; - } else { - printf " %s %s custom selection of collections\n", - $keys[$index], button($vars{'selected_scheme'} eq "scheme-custom"); - } - ++$index; - } - - select_scheme($vars{'selected_scheme'}); - - if ($vars{"binary_win32"}) { - $vars{"collection-wintools"} = 1; - } else { - $vars{"collection-wintools"} = 0; - } - - other_options qw(R Q diskspace); - my $answer = prompt 'Enter letter to select scheme'; - - if (defined $keyval{"$answer"}) { - $vars{'selected_scheme'}=$keyval{"$answer"}; - select_scheme($vars{'selected_scheme'}); - return $command{'self'}->(); - } - if (defined $command{"\u$answer"}) { - return $command{"\u$answer"}->(); - } else { - print "Unknown command: $answer\n\n"; - return $command{'self'}->(); - } -} - - -sub collection_menu { - my %command=( - 'self' => \&collection_menu, - 'R' => \&main_menu, - 'Q' => \&quit - ); - - my @collections; - my @keys=string_to_list "abcdefghijklmnopstuvwxyzABCDEFGHIJKLMNOPSTUVWXYZ"; - my %keyval; - my $index=0; - my @coll_short_desc; - my @coll_long_desc; - - menu_head 'Select collections:'; - - @collections=sort @collections_std; - - foreach my $collection (@collections) { - next if ($collection eq 'collection-perl'); - my $tlpobj = $tlpdb->get_package("$collection"); - if (length $tlpobj->shortdesc>30) { - push @coll_long_desc, $collection; - } else { - push @coll_short_desc, $collection; - } - } - my $singlecolumn_index=@coll_short_desc-1; - -## - my $lines=@coll_short_desc/2; - ++$lines if (@coll_short_desc%2); - for (0..$lines-1) { - $index=$_; - my $collection=$coll_short_desc[$index]; - my $tlpobj = $tlpdb->get_package("$collection"); - $keyval{$keys[$index]}="$collection"; - printf " %s %s %-33s", $keys[$index], button($vars{"$collection"}), - substr($tlpobj->shortdesc,0,33); - if (defined $coll_short_desc[$index+$lines]) { - my $collection=$coll_short_desc[$index+$lines]; - my $tlpobj=$tlpdb->get_package("$collection"); - $keyval{$keys[$index+$lines]}="$collection"; - printf " %s %s %-32s\n", $keys[$index+$lines], - button($vars{"$collection"}), substr($tlpobj->shortdesc,0,32); - } else { - print "\n"; - } - } -## - $index=$singlecolumn_index; -# print "\n$index\n\n"; - foreach my $collection (@coll_long_desc) { - my $tlpobj=$tlpdb->get_package("$collection"); - $keyval{$keys[$index+1]}="$collection"; - printf " %s %s %s\n", $keys[$index+1], button($vars{"$collection"}), - $tlpobj->shortdesc; - ++$index; - } -## - - other_options qw(- + R Q diskspace); - my $answer = prompt 'Enter letter(s) to select collection(s)'; - - my @keystrokes=string_to_list $answer; - - foreach my $keystroke (@keystrokes) { - if ($keystroke eq '-') { - for my $collection (@collections) { - $vars{"$collection"}=0 if defined $vars{"$collection"}; - } - } - if ($keystroke eq '+') { - for my $collection (@collections) { - $vars{"$collection"}=1 if defined $vars{"$collection"}; - } - } - if (defined $keyval{$keystroke}) { - toggle "$keyval{$keystroke}"; - } elsif (!defined $command{"\u$answer"}) { - print "Unknown command: $keystroke\n\n"; - } - } - - if (defined $command{"\u$answer"}) { - # if we play around with collections we also select custom-scheme - # but we do not switch back to originally afterwards, too complicated - # to be done - select_scheme("scheme-custom"); - return $command{"\u$answer"}->(); - } else { - return $command{'self'}->(); - } -} - -sub language_menu { - my %command=( - 'self' => \&language_menu, - 'R' => \&main_menu, - 'Q' => \&quit - ); - - my @languages; - my @lang_docs; - my @lang_keys=string_to_list "abcdefghijklmnopstuvwxyz0123456789"; - my @lang_doc_keys=string_to_list "ABCDEFGHIJKLMNOPSTUVWXYZ"; - my %keyval; - my $lang_index=0; - my $lang_doc_index=0; - my $lines; - - menu_head 'Language support:'; - - @languages=sort @collections_lang; - @lang_docs=sort @collections_lang_doc; - - $lines=@languages/2; - ++$lines if (@languages%2); - for my $index (0..$lines-1) { - my $language=$languages[$index]; - my $tlpobj = $tlpdb->get_package("$language"); - $keyval{$lang_keys[$index]}="$language"; - printf " %s %s %-33s", $lang_keys[$index], button($vars{"$language"}), - substr($tlpobj->shortdesc,0,33); - if (defined $languages[$index+$lines]) { - my $language=$languages[$index+$lines]; - my $tlpobj = $tlpdb->get_package("$language"); - $keyval{$lang_keys[$index+$lines]}="$language"; - printf " %s %s %-32s\n", $lang_keys[$index+$lines], - button($vars{"$language"}), substr($tlpobj->shortdesc,0,32); - } else { - print "\n"; - } - } - - print "\nLanguage-specific documentation:\n\n"; - - $lines=@lang_docs/2; - ++$lines if (@lang_docs%2); - for my $index (0..$lines-1) { - my $lang_doc=$lang_docs[$index]; - my $tlpobj = $tlpdb->get_package("$lang_doc"); - $keyval{$lang_doc_keys[$index]}="$lang_doc"; - printf " %s %s %-33s", $lang_doc_keys[$index], button($vars{"$lang_doc"}), - substr($tlpobj->shortdesc,0,33); - if (defined $lang_docs[$index+$lines]) { - my $lang_doc=$lang_docs[$index+$lines]; - my $tlpobj = $tlpdb->get_package("$lang_doc"); - $keyval{$lang_doc_keys[$index+$lines]}="$lang_doc"; - printf " %s %s %-32s\n", $lang_doc_keys[$index+$lines], - button($vars{"$lang_doc"}), substr($tlpobj->shortdesc,0,32); - } else { - print "\n"; - } - } - - other_options qw (+ - R Q diskspace); - my $answer = prompt 'Enter letter(s) to select language(s)'; - - my @keystrokes=string_to_list $answer; - - foreach my $keystroke (@keystrokes) { - if ($keystroke eq '-') { - for my $collection (@languages,@lang_docs) { - $vars{"$collection"}=0 if defined $vars{"$collection"}; - } - } - if ($keystroke eq '+') { - for my $collection (@languages,@lang_docs) { - $vars{"$collection"}=1 if defined $vars{"$collection"}; - } - } - if (defined $keyval{$keystroke}) { - toggle "$keyval{$keystroke}"; - } elsif (!defined $command{"\u$answer"}) { - print "Unknown command: $keystroke\n\n"; - } - } - - if (defined $keyval{"$answer"}) { - return $command{'self'}->(); - } - if (defined $command{"\u$answer"}) { - select_scheme("scheme-custom"); - return $command{"\u$answer"}->(); - } else { - return $command{'self'}->(); - } -} - - -sub directories_menu -{ - my %command=( - 'self' => \&directories_menu, - 'R' => \&main_menu, - 'Q' => \&quit - ); - - menu_head "Directories setup:"; - if (!TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - print "!! The default location as given below can't be written to. -!! Either change the destination directory using <1> or create it -!! outside this script. -"; - } - my $texmfdir = $vars{'TEXDIR'} . - ($vars{'TEXDIR'} =~ /\/$/ ? 'texmf' : '/texmf'); - if (!$vars{'in_place'}) { - print <<"EOF"; - <1> TEXDIR: $vars{'TEXDIR'} - support tree: $texmfdir -EOF - } else { - print <<"EOF"; - TEXDIR: $vars{'TEXDIR'} - support tree: $texmfdir -EOF - } - if (!$vars{'portable'}) { - print <<"EOF"; - - <2> TEXMFLOCAL: $vars{'TEXMFLOCAL'} - <3> TEXMFSYSVAR: $vars{'TEXMFSYSVAR'} - <4> TEXMFSYSCONFIG: $vars{'TEXMFSYSCONFIG'} - - <5> TEXMFVAR: $vars{'TEXMFVAR'} - <6> TEXMFCONFIG: $vars{'TEXMFCONFIG'} - <7> TEXMFHOME: $vars{'TEXMFHOME'} - -EOF - - if (win32) { - print " Note: ~ will expand to %USERPROFILE%\n"; - } else { - print " Note: ~ will expand to \$HOME (or to %USERPROFILE% on Windows)\n"; - } - } - - other_options qw(R Q); - my $answer = prompt 'Enter command'; - - if ("\u$answer" eq '1' and !$vars{'in_place'}) { - print "New value for TEXDIR [$vars{'TEXDIR'}]: "; - $answer = &input_dirname (); - $vars{'TEXDIR'} = $answer if $answer ne ""; - my $texdirnoslash; - if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { - $texdirnoslash = $1; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/$texlive_release/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/$texlive_release/texmf-config"; - } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { - $texdirnoslash = $1; - $texdirnoslash =~ s!/$!!; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/texmf-config"; - } - return $command{'self'}; - - } elsif ("\u$answer" eq '2' and !$vars{'portable'}) { - print "New value for TEXMFLOCAL [$vars{'TEXMFLOCAL'}]: "; - $answer = &input_dirname (); - $vars{'TEXMFLOCAL'} = $answer if $answer ne ""; - return $command{'self'}; - - } elsif ("\u$answer" eq '3' and !$vars{'portable'}) { - print "New value for TEXMFSYSVAR [$vars{'TEXMFSYSVAR'}]: "; - $answer = &input_dirname (); - $vars{'TEXMFSYSVAR'} = $answer if $answer ne ""; - return $command{'self'}; - - } elsif ("\u$answer" eq '4' and !$vars{'portable'}) { - print "New value for TEXMFSYSCONFIG [$vars{'TEXMFSYSCONFIG'}]: "; - $answer = &input_dirname (); - $vars{'TEXMFSYSCONFIG'} = $answer if $answer ne ""; - return $command{'self'}; - - } elsif ("\u$answer" eq '5' and !$vars{'portable'}) { - print "New value for TEXMFVAR [$vars{'TEXMFVAR'}]: "; - $answer = &input_dirname ("noexpansion"); - $vars{'TEXMFVAR'} = $answer if $answer ne ""; - return $command{'self'}; - - } elsif ("\u$answer" eq '6' and !$vars{'portable'}) { - print "New value for TEXMFCONFIG [$vars{'TEXMFCONFIG'}]: "; - $answer = &input_dirname ("noexpansion"); - $vars{'TEXMFCONFIG'} = $answer if $answer ne ""; - return $command{'self'}; - - } elsif ("\u$answer" eq '7' and !$vars{'portable'}) { - print "New value for TEXMFHOME [$vars{'TEXMFHOME'}]: "; - $answer = &input_dirname ("noexpansion"); - $vars{'TEXMFHOME'} = $answer if $answer ne ""; - return $command{'self'}; - } - - if (defined $command{"\u$answer"}) { - return $command{"\u$answer"}->(); - } else { - print "Unknown command: $answer\n\n"; - return $command{'self'}->(); - } -} - - -# Helper function to read a directory name and clean it up. -# Unless NO_EXPANSION is true, convert to absolute path. -# -sub input_dirname -{ - my $noexpansion = shift; - chomp (my $answer = ); - return "" if $answer eq ""; - - $answer =~ s!\\!/!g if win32(); # switch to forward slashes - - if (!$noexpansion) { - my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if win32(); - $home ||= '~'; - $answer =~ s/^~/$home/; # $home expansion - } - - if ($answer !~ m/^~/) { - # relative paths are unlikely to work in texmf.cnf, et al., - # and don't have any apparent practical use. Convert to absolute. - if (! File::Spec->file_name_is_absolute($answer)) { - $answer = Cwd::abs_path($answer); - } - } - return $answer; -} - - -$vars{'page'}=0; - -sub html2text { - my $filename=shift; - my @text; - open IN, "$filename"; - @all_lines=; - close IN; - chomp @all_lines; - - my $itemcnt; - my $ordered_list=0; - my $h1_indent=25; - my $h2_indent=3; - my $h3_indent=6; - - for (@all_lines) { - next if /DOCTYPE/; - next if /