summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-04-24 15:44:14 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-04-24 15:44:14 +0000
commit9d5bc14f41bbd9219da5d024b1d6a164b51c8525 (patch)
treedbd8181781a4ca5641a7544de85da8ad8e57d3ef
parent1604514ddb81e4dbd0a8f91892afa04cd2c7c07e (diff)
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
-rwxr-xr-xMaster/install-tl300
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm615
-rw-r--r--Master/tlpkg/dev/tlwingoonew/README1
-rw-r--r--Master/tlpkg/dev/tlwingoonew/TLWinGoo.pm1286
-rw-r--r--Master/tlpkg/installer/install-menu-perltk-new.pl1058
-rw-r--r--Master/tlpkg/installer/install-menu-perltk.pl218
-rwxr-xr-xMaster/tlpkg/installer/install-menu-text-new.pl1073
-rwxr-xr-xMaster/tlpkg/installer/install-menu-text.pl194
8 files changed, 737 insertions, 4008 deletions
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 = <TMF>;
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 <<EOF;
+ # we want to write only changes to texmf.cnf
+ # even for in_place installation
+ $TMF = ">$vars{'TEXDIR'}/texmf.cnf";
+ open(TMF, $TMF) || die "open($TMF) failed: $!";
+ print TMF <<EOF;
% (Public domain.)
% This texmf.cnf file should contain only your personal changes from the
% original texmf.cnf (for example, as chosen in the installer).
@@ -1007,52 +998,39 @@ sub do_texmf_cnf {
% And include *only* your changed values, not a copy of the whole thing!
%
EOF
- foreach (@changedtmf) {
- # avoid absolute paths for TEXDIR, use $SELFAUTOPARENT instead
- s/^(TEXMF\w+\s*=\s*)\Q$vars{'TEXDIR'}\E/$1\$SELFAUTOPARENT/;
- print TMF;
- }
- #
- # save the setting of shell_escape to the generated system texmf.cnf
- # default in texmf/web2c/texmf.cnf is
- # shell_escape = p
- # so we write that only if the user *deselected* this option
- if (!$vars{"option_write18_restricted"}) {
- print TMF <<EOF;
+ foreach (@changedtmf) {
+ # avoid absolute paths for TEXDIR, use $SELFAUTOPARENT instead
+ s/^(TEXMF\w+\s*=\s*)\Q$vars{'TEXDIR'}\E/$1\$SELFAUTOPARENT/;
+ print TMF;
+ }
+ #
+ # save the setting of shell_escape to the generated system texmf.cnf
+ # default in texmf/web2c/texmf.cnf is
+ # shell_escape = p
+ # so we write that only if the user *deselected* this option
+ if (!$vars{"option_write18_restricted"}) {
+ print TMF <<EOF;
% Disable system commands via \\write18{...}. See texmf/web2c/texmf.cnf.
shell_escape = 0
EOF
;
- }
- if ($rewritetmflua) {
- $TMFLUA = ">$vars{'TEXDIR'}/texmfcnf.lua";
- open(TMFLUA, $TMFLUA) || die "open($TMFLUA) failed: $!";
- }
-
- } else {
- # running from DVD, have to use a different directory.
- $TMF = ">$vars{'TEXMFSYSVAR'}/web2c/texmf.cnf";
- open (TMF, $TMF) || die "open($TMF) failed (dvd): $!\n";
- foreach (@newtmf) { print TMF; }
-
- if ($rewritetmflua) {
- $TMFLUA = ">$vars{'TEXMFSYSVAR'}/web2c/texmfcnf.lua";
- open(TMFLUA, $TMFLUA) || die "open($TMFLUA) failed (dvd): $!";
- }
}
close(TMF) || warn "close($TMF) failed: $!";
- # contents of the revised texmfcnf.lua is the same whether from_dvd or not.
if ($rewritetmflua) {
+ $TMFLUA = ">$vars{'TEXDIR'}/texmfcnf.lua";
+ open(TMFLUA, $TMFLUA) || die "open($TMFLUA) failed: $!";
+
print TMFLUA <<EOF;
-- (Public domain.)
-- This texmfcnf.lua file should exist only if you have personal changes
-- from the distributed file; for example, if TEXMFVAR was changed in
-- the installer.
---
+--
return { TEXMFCACHE = '$vars{"TEXMFVAR"}' }
EOF
+
close(TMFLUA) || warn "close($TMFLUA) failed: $!";
}
}
@@ -1099,7 +1077,8 @@ sub set_platforms_supported {
# TEXLIVE_INSTALL_TEXMFHOME '$HOME/texmf'
sub set_texlive_default_dirs {
- my $tex_prefix = getenv('TEXLIVE_INSTALL_PREFIX');
+ my $tex_prefix = $vars{'in_place'} ? abs_path($::installerdir) :
+ getenv('TEXLIVE_INSTALL_PREFIX');
if (win32) {
$tex_prefix ||= getenv('SystemDrive') . '/texlive';
# we use SystemDrive because ProgramFiles requires admin rights
@@ -1108,24 +1087,24 @@ sub set_texlive_default_dirs {
} else {
$tex_prefix ||= '/usr/local/texlive';
}
- # for portable installation we want everything in one directory
- $vars{'TEXDIRW'} = $vars{'portable'}
+ # for portable and in_place installation we want everything in one directory
+ $vars{'TEXDIR'} = ($vars{'portable'} || $vars{'in_place'})
? $tex_prefix : "$tex_prefix/$texlive_release";
my $texmfsysvar = getenv('TEXLIVE_INSTALL_TEXMFSYSVAR');
- $texmfsysvar ||= $vars{'TEXDIRW'} . '/texmf-var';
+ $texmfsysvar ||= $vars{'TEXDIR'} . '/texmf-var';
$vars{'TEXMFSYSVAR'} = $texmfsysvar;
my $texmfsysconfig = getenv('TEXLIVE_INSTALL_TEXMFSYSCONFIG');
- $texmfsysconfig ||= $vars{'TEXDIRW'} . '/texmf-config';
+ $texmfsysconfig ||= $vars{'TEXDIR'} . '/texmf-config';
$vars{'TEXMFSYSCONFIG'}=$texmfsysconfig;
my $texmflocal = getenv('TEXLIVE_INSTALL_TEXMFLOCAL');
$texmflocal ||= "$tex_prefix/texmf-local";
$vars{'TEXMFLOCAL'} = $texmflocal;
- $vars{'TEXDIR'} = $vars{'from_dvd'}
- ? abs_path($::installerdir) : $vars{'TEXDIRW'};
+ $vars{'TEXDIR'} = $vars{'in_place'}
+ ? abs_path($::installerdir) : $vars{'TEXDIR'};
my $texmfhome = getenv('TEXLIVE_INSTALL_TEXMFHOME');
$texmfhome ||= "~";
@@ -1140,7 +1119,7 @@ sub set_texlive_default_dirs {
my $texmfconfig = getenv('TEXLIVE_INSTALL_TEXMFCONFIG');
$texmfconfig ||= "$texmfhome/.texlive$yyyy/texmf-config";
$vars{'TEXMFCONFIG'} = $texmfconfig;
-
+
# for portable installation we want everything in one directory
if ($vars{'portable'}) {
$vars{'TEXMFHOME'} = "\$TEXMFLOCAL";
@@ -1295,7 +1274,7 @@ sub load_tlpdb {
$location .= "/systems/texlive/tlnet";
$master = $location;
#
- # since we change location, we reset the error count of the
+ # since we change location, we reset the error count of the
# download object
$::tldownload_server->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<wget> 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<PORTABLE USE> 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<selected_scheme> and I<no> collection variable is defined in the
profile, then the collections which the specified scheme requires are
installed. Thus, a simple line C<selected_scheme scheme-medium>
-together with the definitions of the paths (C<TEXDIR>, C<TEXDIRW>,
+together with the definitions of the paths (C<TEXDIR>,
C<TEXMFHOME>, C<TEXMFLOCAL>, C<TEXMFSYSCONFIG>, C<TEXMFSYSVAR>) 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<tl-portable> and a DOS batch file C<tl-portable.bat> 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<TeXLive::TLWinGoo> -- 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
&register_file_type
&unregister_file_type
+ &register_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<win_which_dir>
-
-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<win_which_dir>
+#
+#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 = <STDIN>;
+ 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<register_extension($mode, $extension, $file_type)>
-
-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<register_extension($mode, $extension, $file_type)>
+
+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<register_application($prog, $path, $exts)>
+
+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<unregister_application($prog)>
+
+Reversal of register_application
+
+=cut
+
+sub unregister_application {
+ my $prog = shift;
+ do_remove_regkey(2, "Software/Classes/Applications/$prog/");
+}
+
+=pod
+
+=item C<add_to_openwithlist($ext, $prog)>
+
+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_from_openwithlist($ext, $prog)>
+
+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 <<UNEND;
\@echo off
setlocal
@@ -1101,18 +1194,18 @@ path $td\\tlpkg\\tlperl\\bin;$td\\bin\\win32;%path%
set PERL5LIB=$td\\tlpkg\\tlperl\\lib
perl.exe \"$td\\texmf\\scripts\\texlive\\uninstall-win32.pl\"
if errorlevel 1 goto :eof
-copy \"$tdw\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\"
+copy \"$td\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\"
rem pause
\"\%TEMP\%\\uninst2.bat\"
UNEND
;
close UNINST;
} else {
- warn "Cannot open $tdwfw/tlpkg/installer/uninst.bat for append";
+ warn "Cannot open $tdfw/tlpkg/installer/uninst.bat for append";
}
- if (open UNINST2, ">$tdwfw/tlpkg/installer/uninst2.bat") {
- print UNINST2 <<UNEND2 if ($td eq $tdw);
+ if (open UNINST2, ">$tdfw/tlpkg/installer/uninst2.bat") {
+ print UNINST2 <<UNEND2;
rmdir /s /q \"$td\\texmf-dist\"
rmdir /s /q \"$td\\texmf-doc\"
rmdir /s /q \"$td\\texmf\"
@@ -1135,14 +1228,14 @@ UNEND2
print UNINST2 <<UNEND2;
rmdir /s /q \"$tdsv\"
rmdir /s /q \"$tdsc\"
-rmdir /s /q \"$tdw\\temp\"
-rmdir /s /q \"$tdw\\tlpkg\"
-del \"$tdw\\install-tl.log\"
-del \"$tdw\\texlive.profile\" 2>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<TeXLive::TLWinGoo> -- 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
- &reg_country
- &expand_string
- &global_tmpdir
- &get_system_path
- &get_user_path
- &setenv_reg
- &unsetenv_reg
- &adjust_reg_path_for_texlive
- &register_extension
- &unregister_extension
- &register_file_type
- &unregister_file_type
- &register_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<win_version>
-
-C<win_version> 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<is_vista>
-
-C<is_vista> 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<admin>
-
-Returns admin status, admin implying having full read-write access
-to the system environment.
-
-=cut
-
-sub admin { return $is_admin; }
-
-=pod
-
-=item C<non_admin>
-
-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<reg_country>
-
-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<expand_string($s)>
-
-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<global_tmpdir>
-
-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<get_system_path>
-
-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<get_user_path>
-
-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<win_which_dir>
-#
-#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<setenv_reg($env_var, $env_data[, $mode]);>
-
-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<unsetenv_reg($env_var[, $mode]);>
-
-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<tex_dirs_on_path($path)>
-
-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<adjust_reg_path_for_texlive($action, $tlbindir, $mode)>
-
-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 = <STDIN>;
- 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<register_extension($mode, $extension, $file_type)>
-
-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<unregister_extension($mode, $extension, $filetype)>
-
-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<register_file_type($file_type, $command)>
-
-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<unregister_file_type($file_type)>
-
-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<register_application($prog, $path, $exts)>
-
-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<unregister_application($prog)>
-
-Reversal of register_application
-
-=cut
-
-sub unregister_application {
- my $prog = shift;
- do_remove_regkey(2, "Software/Classes/Applications/$prog/");
-}
-
-=pod
-
-=item C<add_to_openwithlist($ext, $prog)>
-
-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_from_openwithlist($ext, $prog)>
-
-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<broadcast_env>
-
-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<update_assocs>
-
-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<shell_folder>
-
-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_desktop_shortcut($name, $icon, $prog, $args, $batgui)>
-
-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_menu_shortcut($place, $name, $icon,
- $prog, $args, $batgui)>
-
-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<remove_desktop_shortcut($name)>
-
-For uninstallation of an individual package.
-
-=cut
-
-sub remove_desktop_shortcut {
- my $name = shift;
- unlink desktop_path().'/'.$name.'.lnk';
-}
-
-=pod
-
-=item C<remove_menu_shortcut($place, $name)>
-
-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<create_uninstaller>
-
-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 <<UNEND;
-\@echo off
-setlocal
-rem This should not be necessary, but sometimes it is:
-path $td\\tlpkg\\tlperl\\bin;$td\\bin\\win32;%path%
-set PERL5LIB=$td\\tlpkg\\tlperl\\lib
-perl.exe \"$td\\texmf\\scripts\\texlive\\uninstall-win32.pl\"
-if errorlevel 1 goto :eof
-copy \"$tdw\\tlpkg\\installer\\uninst2.bat\" \"\%TEMP\%\"
-rem pause
-\"\%TEMP\%\\uninst2.bat\"
-UNEND
-;
- close UNINST;
- } else {
- warn "Cannot open $tdwfw/tlpkg/installer/uninst.bat for append";
- }
-
- if (open UNINST2, ">$tdwfw/tlpkg/installer/uninst2.bat") {
- print UNINST2 <<UNEND2 if ($td eq $tdw);
-rmdir /s /q \"$td\\texmf-dist\"
-rmdir /s /q \"$td\\texmf-doc\"
-rmdir /s /q \"$td\\texmf\"
-rmdir /s /q \"$td\\readme-html.dir\"
-rmdir /s /q \"$td\\readme-txt.dir\"
-rmdir /s /q \"$td\\bin\"
-rmdir /s /q \"$td\\tlpkg\"
-del /q \"$td\\README.*\"
-del /q \"$td\\LICENSE.*\"
-del /q \"$td\\doc.html\"
-del \"$td\\index.html\"
-del \"$td\\texmf.cnf\"
-del \"$td\\install-tl\"
-del \"$td\\tl-portable\"
-del \"$td\\tl-portable.bat\"
-del \"$td\\install-tl.bat\"
-del \"$td\\install-tl-advanced.bat\"
-UNEND2
-;
- print UNINST2 <<UNEND2;
-rmdir /s /q \"$tdsv\"
-rmdir /s /q \"$tdsc\"
-rmdir /s /q \"$tdw\\temp\"
-rmdir /s /q \"$tdw\\tlpkg\"
-del \"$tdw\\install-tl.log\"
-del \"$tdw\\texlive.profile\" 2>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<unregister_uninstaller>
-
-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('<Escape>', [ $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('<Return>' => [ $ok, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>', [ $okbutton, 'Invoke' ]);
- $sw->bind('<Escape>', [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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('<Return>' => [ $okbutton, 'Invoke']);
- $sw->bind('<Escape>' => [ $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 = <STDIN>;
- $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 = <STDIN>);
- 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;
-
-##<cols=2>
- 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";
- }
- }
-##</cols=2>
- $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;
- }
-##</cols=1>
-
- 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 = <STDIN>);
- 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=<IN>;
- 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 /<!--/;
- next if /<title/i;
- next if /<\/?body/i;
- next if /<\/?html/i;
- next if /<\/?head/i;
- next if /<\/?meta/i;
- next if /^\s*$/; # ignore empty lines
-
- s/<i>/"/gi; s/<\/i>/"/gi; # italics
- s/<tt>/'/gi; s/<\/tt>/'/gi; # typewriter
- s/<p>.*//gi; # paragraphs
- s/<\/ul>.*//gi; # unsorted lists
- s/<\/ol>.*//gi; # ordered lists
- s/&mdash;/--/gi; # mdash
- s/&lt;/</gi; s/&gt;/>/gi; # < and >
- if (/<h1>(.*?)<\/h1>/i) {
- push @text, " " x $h1_indent. "$1\n";
- push @text, " " x $h1_indent. "=" x (length $1). "\n";
- push @text, "\n";
- } elsif (/<h2>(.*?)<\/h2>/i) {
- push @text, "\n";
- push @text, " " x $h2_indent. "$1\n";
- push @text, " " x $h2_indent. "~" x (length $1). "\n";
- push @text, "\n";
- } elsif (/<h3>(.*?)<\/h3>/i) {
- push @text, "\n";
- push @text, " " x $h3_indent. "$1\n";
- push @text, " " x $h3_indent. "-" x (length $1). "\n";
- push @text, "\n";
- } elsif (/<ol>/i) {
- $ordered_list=1;
- $itemcnt=1;
- } elsif (/<ul>/i) {
- $ordered_list=0;
- } elsif (/^\s*<li>\s*(.*)/) {
- if ($ordered_list) {
- push @text, "\n";
- push @text, " $itemcnt. $1\n";
- ++$itemcnt;
- } else {
- push @text, "\n";
- push @text, " * $1\n";
- }
- } else {
- push @text, "$_\n";
- }
- }
- return @text;
-}
-
-
-sub help_menu {
- my %command=(
- 'self' => \&help_menu,
- 'R' => \&main_menu,
- 'Q' => \&quit
- );
- my $installer_help="$installerdir/tlpkg/installer/install-tl.html";
-
- clear_screen;
-
- my @text=html2text "$installer_help";
- my $lines=(@text);
- my $overlap=3;
- my $lps=32; # lines per screen - overlap
- my $firstline=$vars{'page'}*$lps;
- my $lastline=$firstline+$lps+$overlap;
- my $line=0;
-# print "<<<$firstline>>> <<<$lastline>>>\n";
- for (@text) {
- print "$_" if ($line>=$firstline and $line<=$lastline);
- ++$line;
- }
- print "\n", hbar,
- " <T> top <N> next page <P> previous page <R> return"
- . " <Q> quit --", $vars{'page'}+1, "--\n";
-
- my $answer = prompt 'Enter command';
-
- if ("\u$answer" eq 'T') {
- $vars{'page'}=0;
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'N') {
- $vars{'page'}+=1 unless $lastline>$lines;
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'P') {
- $vars{'page'}-=1 if $vars{'page'}>=1;
- return $command{'self'};
-
- } elsif (defined $command{"\u$answer"}) {
- return $command{"\u$answer"};
-
- } else {
- print "Unknown command: $answer\n\n";
- return $command{'self'};
- }
-}
-
-
-sub options_menu {
- my $b_path=button($vars{'option_path'});
- my $b_doc=button($vars{'option_doc'});
- my $b_src=button($vars{'option_src'});
- my $b_fmt=button($vars{'option_fmt'});
- my $b_letter=button($vars{'option_letter'});
- my $b_deskint=button($vars{'option_desktop_integration'});
- my $b_admin=button($vars{'option_w32_multi_user'});
- my $b_addoneditor=button($vars{'collection-texworks'});
- my $b_restricted=button($vars{'option_write18_restricted'});
-
- my $sys_bin=$vars{'option_sys_bin'};
- my $sys_man=$vars{'option_sys_man'};
- my $sys_info=$vars{'option_sys_info'};
-
- my $t_sys_bin=($vars{'option_path'})? $vars{'option_sys_bin'}:'';
- my $t_sys_man=($vars{'option_path'})? $vars{'option_sys_man'}:'';
- my $t_sys_info=($vars{'option_path'})? $vars{'option_sys_info'}:'';
-
- my %command=(
- 'self' => \&options_menu,
- 'R' => \&main_menu,
- 'Q' => \&quit
- );
-
- clear_screen;
- menu_head "Options setup:";
-
- print <<"EOF";
- <P> use letter size instead of A4 by default: $b_letter
- <E> execution of restricted list of programs: $b_restricted
- <F> create format files: $b_fmt
-EOF
-;
- if ($vars{'doc_splitting_supported'} and !$vars{'in_place'}) {
- print " <D> install font/macro doc tree: $b_doc\n";
- }
- if ($vars{'src_splitting_supported'} and !$vars{'in_place'}) {
- print " <S> install font/macro source tree: $b_src\n";
- }
- if (!$vars{'portable'}) {
- if (unix() || $::opt_all_options) {
- print <<"EOF";
- <L> create symlinks in standard directories: $b_path
- binaries to: $t_sys_bin
- manpages to: $t_sys_man
- info to: $t_sys_info
-EOF
-;
- } else {
- print <<"EOF";
- <L> adjust registry entry for path: $b_path
-EOF
-;
- }
- if (win32() || $::opt_all_options) {
- print " <M> install menu items, shortcuts, etc: $b_deskint\n";
- print " <N> update file associations: [$::fileassocdesc[$vars{'option_file_assocs'}]]\n";
- if ($::opt_all_options || TeXLive::TLWinGoo::admin()) {
- # if we are admin we allow normal user installation, too
- print " <U> make installation available to all users: $b_admin\n";
- }
- }
- }
- if (win32() || $::opt_all_options) {
- print " <W> install TeXworks front end: $b_addoneditor\n";
- }
- other_options qw(R Q diskspace);
- my $answer = prompt 'Enter command';
-
- # option_path
-
- if (unix()) {
- if (("\u$answer" eq 'L') and !$vars{'portable'}) {
- my $home = getenv('HOME');
- $home = getenv('USERPROFILE') if (win32());
- $home ||= '~';
- toggle 'option_path';
- if ($vars{'option_path'}) {
- print "New value for binary directory [$sys_bin]: ";
- chomp($answer=<STDIN>);
- $vars{'option_sys_bin'} = "$answer" if (length $answer);
- $vars{'option_sys_bin'} =~ s@\\@/@g if (win32());
- $vars{'option_sys_bin'} =~ s/^~/$home/;
- if ($vars{'option_sys_bin'}=~/^(.*)\/bin$/) {
- $vars{'option_sys_man'}="$1/man";
- $vars{'option_sys_info'}="$1/info";
- }
- print "New value for man directory [$vars{'option_sys_man'}]: ";
- chomp($answer=<STDIN>);
- $vars{'option_sys_man'}="$answer" if (length $answer);
- $vars{'option_sys_man'} =~ s@\\@/@g if (win32());
- $vars{'option_sys_man'} =~ s/^~/$home/;
-
- print "New value for info directory [$vars{'option_sys_info'}]: ";
- chomp($answer=<STDIN>);
- $vars{'option_sys_info'}="$answer" if (length $answer);
- $vars{'option_sys_info'} =~ s@\\@/@g if (win32());
- $vars{'option_sys_info'} =~ s/^~/$home/;
- }
- return $command{'self'};
- }
- } else {
- if (("\u$answer" eq 'L') and !$vars{'portable'}) {
- my $home = getenv('HOME');
- $home = getenv('USERPROFILE') if (win32());
- $home ||= '~';
- toggle 'option_path';
- return $command{'self'};
- }
- }
-
- # option_desktop_integration, option_file_assocs
-
- if (win32() || $::opt_all_options) {
- if ("\u$answer" eq 'M' and !$vars{'portable'}) {
- toggle 'option_desktop_integration';
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'N' and !$vars{'portable'}) {
- print "New value for file_assocs:\n";
- print " 0 -- don't tweak the file associations\n";
- print " 1 -- only add new file associations, don't overwrite old ones\n";
- print " 2 -- always create file associations to TeX Live programs\n";
- print "New value for file_assocs [$vars{'option_file_assocs'}]: ";
- chomp (my $a = <STDIN>);
- if ($a eq "0" || $a eq "1" || $a eq "2") {
- $vars{'option_file_assocs'} = $a;
- }
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'U' and !$vars{'portable'}) {
- toggle 'option_w32_multi_user';
- return $command{'self'};
- }
- }
-
- # other options
-
- if ("\u$answer" eq 'P') {
- toggle 'option_letter';
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'F') {
- toggle 'option_fmt';
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'E') {
- toggle 'option_write18_restricted';
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'S' and !$vars{'in_place'}) {
- toggle 'option_src';
- return $command{'self'};
-
- } elsif ("\u$answer" eq 'D' and !$vars{'in_place'}) {
- toggle 'option_doc';
- return $command{'self'};
-
- } elsif (defined $command{"\u$answer"}) {
- return $command{"\u$answer"};
-
- } elsif (("\u$answer" eq 'W') && ($::opt_all_options || win32()) &&
- !$vars{'in_place'} ) {
- toggle 'collection-texworks';
- return $command{'self'};
-
- } else {
- print "Unknown or unsupported command: $answer\n\n";
- return $command{'self'};
- }
-}
-
-
-sub quit {
- exit 0;
- $RETURN = $MENU_QUIT;
-}
-
-sub do_install {
- $RETURN = $MENU_INSTALL;
-}
-
-sub toggle_portable {
- if ($vars{'portable'}) {
- $vars{'portable'} = 0;
- $vars{'option_desktop_integration'} = 0;
- $vars{'option_path'} = 0;
- $vars{'option_file_assocs'} = 0;
- $vars{'option_w32_multi_user'} = 0;
- } else {
- $vars{'portable'} = 1;
- $vars{'option_desktop_integration'} = 1;
- $vars{'option_path'} = 1;
- $vars{'option_file_assocs'} = 1;
- $vars{'option_w32_multi_user'} = 1;
- }
- set_texlive_default_dirs(); # this sub tests for portable and in_place
- main_menu;
-}
-
-sub main_menu {
- my $this_platform=platform_desc($vars{'this_platform'});
-
- my $b_path=button($vars{'option_path'});
- my $b_doc=button($vars{'option_doc'});
- my $b_src=button($vars{'option_src'});
- my $b_fmt=button($vars{'option_fmt'});
- my $b_letter=button($vars{'option_letter'});
- my $b_deskint=button($vars{'option_desktop_integration'});
- my $b_admin=button($vars{'option_w32_multi_user'});
- my $b_addoneditor=button($vars{'collection-texworks'});
- my $b_restricted=button($vars{'option_write18_restricted'});
-
- my $warn_nobin;
-
- $warn_nobin=set_install_platform;
-
- $vars{'n_systems_selected'}=0;
- $vars{'n_collections_selected'}=0;
- foreach my $key (keys %vars) {
- if ($key=~/^binary.*/) {
- ++$vars{'n_systems_selected'} if $vars{$key}==1;
- }
- if ($key=~/^collection/) {
- ++$vars{'n_collections_selected'} if $vars{$key}==1;
- }
- }
- calc_depends();
-
- my %command = (
- 'self' => \&main_menu,
- 'D' => \&directories_menu,
- 'H' => \&help_menu,
- 'I' => \&do_install,
- 'O' => \&options_menu,
- 'Q' => \&quit,
- 'V' => \&toggle_portable,
- );
- if (!$vars{'in_place'}) {
- $command{'B'} = \&binary_menu if unix();
- $command{'C'} = \&collection_menu;
- $command{'L'} = \&language_menu;
- $command{'S'} = \&scheme_menu;
- }
-
- clear_screen;
- print <<"EOF";
-======================> TeX Live installation procedure <=====================
-
-=======> Note: Letters/digits in <angle brackets> indicate menu items <=======
-=======> for commands or configurable options <=======
-
- Detected platform: $this_platform
- $warn_nobin
-EOF
-
- if (!$vars{'in_place'}) {
- print <<"EOF";
- <B> platforms: $vars{'n_systems_selected'} out of $vars{'n_systems_available'}
-
- <S> installation scheme ($vars{'selected_scheme'})
- $vars{'n_collections_selected'} collections out of $vars{'n_collections_available'}, disk space required: $vars{'total_size'} MB
-
- Customizing installation scheme:
- <C> standard collections
- <L> language collections
-EOF
-
- if (!check_on_lang_collection_installed()) {
- print " !! No language specific collection selected!\n";
- print " !! If you only write American English documents that is fine!\n";
- }
- }
- print <<"EOF";
-
- <D> directories:
- TEXDIR (the main TeX directory):
-EOF
-
- if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
- print " $vars{'TEXDIR'}\n";
- } else {
- print " !! default location: $vars{'TEXDIR'}\n";
- print " !! is not writable, please select a different one!\n";
- }
- print <<"EOF";
- TEXMFLOCAL (directory for site-wide local files):
- $vars{'TEXMFLOCAL'}
- TEXMFSYSVAR (directory for variable and automatically generated data):
- $vars{'TEXMFSYSVAR'}
- TEXMFSYSCONFIG (directory for local config):
- $vars{'TEXMFSYSCONFIG'}
- TEXMFVAR (personal directory for variable and automatically generated data):
- $vars{'TEXMFVAR'}
- TEXMFCONFIG (personal directory for local config):
- $vars{'TEXMFCONFIG'}
- TEXMFHOME (directory for user-specific files):
- $vars{'TEXMFHOME'}
-
-EOF
-
-print <<"EOF";
- <O> options:
- $b_letter use letter size instead of A4 by default
- $b_restricted allow execution of restricted list of programs via \\write18
- $b_fmt create all format files
-EOF
-
- if (!$vars{'in_place'}) {
- if ($vars{'doc_splitting_supported'}) {
- print " $b_doc install macro/font doc tree\n";
- }
- if ($vars{'src_splitting_supported'}) {
- print " $b_src install macro/font source tree\n";
- }
- }
- if (win32()) {
- if (!$vars{'portable'}) {
- print " $b_path adjust search path\n";
- print " $b_deskint add menu items, shortcuts, etc.\n";
- print " [$vars{'option_file_assocs'}] update file associations\n";
- if (admin()) {
- print " $b_admin make installation available to all users\n";
- }
- }
- print " $b_addoneditor install TeXworks front end\n";
- print " $b_path create symlinks to standard directories\n" unless
- ($vars{'portable'} || win32());
- }
-
- if ($vars{'portable'}) {
- print "\n <V> set up for regular installation to hard disk\n";
- } else {
- print "\n <V> set up for portable installation\n";
- }
-
- other_options qw(I H Q);
- my $answer = prompt 'Enter command';
-
- if (defined $command{"\u$answer"}) {
- return $command{"\u$answer"};
- } else {
- print "Unknown command: $answer\n\n";
- return $command{'self'};
- }
-}
-
-# needs a terminal 1 for require to succeed!
-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-text.pl b/Master/tlpkg/installer/install-menu-text.pl
index 9807d0f6976..57325029979 100755
--- a/Master/tlpkg/installer/install-menu-text.pl
+++ b/Master/tlpkg/installer/install-menu-text.pl
@@ -73,11 +73,8 @@ sub other_options {
'Q' => 'quit'
);
- if ($vars{'from_dvd'}) {
- $opts{'I'}='start installation for running from DVD';
- } else {
- $opts{'I'}='start installation to hard disk';
- }
+ $opts{'I'}=$vars{'portable'} ? 'start portable installation' :
+ 'start installation to hard disk';
print "\nActions:";
if ($options[$#options] eq 'diskspace') {
@@ -86,7 +83,7 @@ sub other_options {
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};
@@ -109,7 +106,7 @@ sub prompt {
# reference to another menu or to itself.
sub run_menu_text {
my (@args) = @_;
- # the text mode installer does not take interest in any argument
+ # the text mode installer does not take interest in any argument
# but the -old-installation-found
while (@args) {
my $f = shift @args;
@@ -229,7 +226,7 @@ sub scheme_menu {
printf " %s %s %s\n", $keys[$index], button($vars{"$scheme"}),
$tlpobj->shortdesc;
} else {
- printf " %s %s custom selection of collections\n",
+ printf " %s %s custom selection of collections\n",
$keys[$index], button($vars{'selected_scheme'} eq "scheme-custom");
}
++$index;
@@ -459,27 +456,28 @@ sub directories_menu
'Q' => \&quit
);
- my $maindir = $vars{'from_dvd'} ? 'TEXDIRW' : 'TEXDIR';
-
menu_head "Directories setup:";
- if (!TeXLive::TLUtils::texdir_check($vars{$maindir})) {
+ 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.
";
}
- if ($vars{'from_dvd'}) {
- print <<"EOF";
- <1> TEXDIRW: $vars{'TEXDIRW'}
- (root for configuration- and generated data)
+ 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";
- <1> TEXDIR: $vars{'TEXDIR'}
- support tree: $vars{'TEXDIR'}/texmf
+ TEXDIR: $vars{'TEXDIR'}
+ support tree: $texmfdir
EOF
}
- print <<"EOF";
+ if (!$vars{'portable'}) {
+ print <<"EOF";
<2> TEXMFLOCAL: $vars{'TEXMFLOCAL'}
<3> TEXMFSYSVAR: $vars{'TEXMFSYSVAR'}
@@ -491,62 +489,66 @@ EOF
EOF
- if (win32) {
- print " Note: ~ will expand to %USERPROFILE%\n";
- } else {
- print " Note: ~ will expand to \$HOME (or to %USERPROFILE% on Windows)\n";
+ 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') {
- print "New value for $maindir [$vars{$maindir}]: ";
+ if ("\u$answer" eq '1' and !$vars{'in_place'}) {
+ print "New value for TEXDIR [$vars{'TEXDIR'}]: ";
$answer = &input_dirname ();
- $vars{$maindir} = $answer if $answer ne "";
- if ($vars{$maindir}=~/^(.*)\/$texlive_release$/) {
- $vars{'TEXMFLOCAL'}="$1/texmf-local";
- $vars{'TEXMFSYSVAR'}="$1/$texlive_release/texmf-var";
- $vars{'TEXMFSYSCONFIG'}="$1/$texlive_release/texmf-config";
- } elsif ($vars{$maindir}=~/^(.*)$/) {
- $vars{'TEXMFLOCAL'}="$1/texmf-local";
- $vars{'TEXMFSYSVAR'}="$1/texmf-var";
- $vars{'TEXMFSYSCONFIG'}="$1/texmf-config";
+ $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";
}
- $vars{'TEXDIRW'} = $vars{'TEXDIR'} unless $vars{'from_dvd'};
return $command{'self'};
- } elsif ("\u$answer" eq '2') {
+ } 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') {
+ } 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') {
+ } 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') {
+ } 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') {
+ } 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') {
+ } 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 "";
@@ -564,13 +566,13 @@ EOF
# 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 = <STDIN>);
return "" if $answer eq "";
-
+
$answer =~ s!\\!/!g if win32(); # switch to forward slashes
if (!$noexpansion) {
@@ -579,7 +581,7 @@ sub input_dirname
$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.
@@ -744,13 +746,13 @@ sub options_menu {
<F> create format files: $b_fmt
EOF
;
- if ($vars{'doc_splitting_supported'} and !$vars{'from_dvd'}) {
+ if ($vars{'doc_splitting_supported'} and !$vars{'in_place'}) {
print " <D> install font/macro doc tree: $b_doc\n";
}
- if ($vars{'src_splitting_supported'} and !$vars{'from_dvd'}) {
+ if ($vars{'src_splitting_supported'} and !$vars{'in_place'}) {
print " <S> install font/macro source tree: $b_src\n";
}
- if (!$vars{'from_dvd'}) {
+ if (!$vars{'portable'}) {
if (unix() || $::opt_all_options) {
print <<"EOF";
<L> create symlinks in standard directories: $b_path
@@ -772,14 +774,18 @@ EOF
# if we are admin we allow normal user installation, too
print " <U> make installation available to all users: $b_admin\n";
}
- print " <W> install TeXworks front end: $b_addoneditor\n";
}
}
+ if (win32() || $::opt_all_options) {
+ print " <W> install TeXworks front end: $b_addoneditor\n";
+ }
other_options qw(R Q diskspace);
my $answer = prompt 'Enter command';
+ # option_path
+
if (unix()) {
- if (("\u$answer" eq 'L') and !$vars{'from_dvd'}) {
+ if (("\u$answer" eq 'L') and !$vars{'portable'}) {
my $home = getenv('HOME');
$home = getenv('USERPROFILE') if (win32());
$home ||= '~';
@@ -809,7 +815,7 @@ EOF
return $command{'self'};
}
} else {
- if (("\u$answer" eq 'L') and !$vars{'from_dvd'}) {
+ if (("\u$answer" eq 'L') and !$vars{'portable'}) {
my $home = getenv('HOME');
$home = getenv('USERPROFILE') if (win32());
$home ||= '~';
@@ -817,12 +823,15 @@ EOF
return $command{'self'};
}
}
+
+ # option_desktop_integration, option_file_assocs
+
if (win32() || $::opt_all_options) {
- if ("\u$answer" eq 'M') {
+ if ("\u$answer" eq 'M' and !$vars{'portable'}) {
toggle 'option_desktop_integration';
return $command{'self'};
- } elsif ("\u$answer" eq 'N') {
+ } elsif ("\u$answer" eq 'N' and !$vars{'portable'}) {
print "New value for file_assocs:\n";
print " 0 -- don't tweak the file associations\n";
print " 1 -- only add new file associations, don't overwrite old ones\n";
@@ -834,12 +843,14 @@ EOF
}
return $command{'self'};
- } elsif ("\u$answer" eq 'U') {
+ } elsif ("\u$answer" eq 'U' and !$vars{'portable'}) {
toggle 'option_w32_multi_user';
return $command{'self'};
}
}
+ # other options
+
if ("\u$answer" eq 'P') {
toggle 'option_letter';
return $command{'self'};
@@ -852,23 +863,24 @@ EOF
toggle 'option_write18_restricted';
return $command{'self'};
- } elsif ("\u$answer" eq 'S' and !$vars{'from_dvd'}) {
+ } elsif ("\u$answer" eq 'S' and !$vars{'in_place'}) {
toggle 'option_src';
return $command{'self'};
- } elsif ("\u$answer" eq 'D' and !$vars{'from_dvd'}) {
+ } elsif ("\u$answer" eq 'D' and !$vars{'in_place'}) {
toggle 'option_doc';
return $command{'self'};
} elsif (defined $command{"\u$answer"}) {
return $command{"\u$answer"};
- } elsif (("\u$answer" eq 'W') && ($::opt_all_options || win32())) {
+ } elsif (("\u$answer" eq 'W') && ($::opt_all_options || win32()) &&
+ !$vars{'in_place'} ) {
toggle 'collection-texworks';
return $command{'self'};
} else {
- print "Unknown command: $answer\n\n";
+ print "Unknown or unsupported command: $answer\n\n";
return $command{'self'};
}
}
@@ -883,15 +895,21 @@ sub do_install {
$RETURN = $MENU_INSTALL;
}
-sub dvd_hd_toggle {
- return if !member('local_uncompressed', @media_available);
- if ($vars{'from_dvd'}) { # set up for hd install:
- $vars{'from_dvd'} = 0;
- $vars{'TEXDIR'} = $vars{'TEXDIRW'};
- } else { # set up for dvd install:
- $vars{'from_dvd'} = 1;
- $vars{'TEXDIR'} = abs_path($::installerdir);
+sub toggle_portable {
+ if ($vars{'portable'}) {
+ $vars{'portable'} = 0;
+ $vars{'option_desktop_integration'} = 0;
+ $vars{'option_path'} = 0;
+ $vars{'option_file_assocs'} = 0;
+ $vars{'option_w32_multi_user'} = 0;
+ } else {
+ $vars{'portable'} = 1;
+ $vars{'option_desktop_integration'} = 1;
+ $vars{'option_path'} = 1;
+ $vars{'option_file_assocs'} = 1;
+ $vars{'option_w32_multi_user'} = 1;
}
+ set_texlive_default_dirs(); # this sub tests for portable and in_place
main_menu;
}
@@ -912,8 +930,6 @@ sub main_menu {
$warn_nobin=set_install_platform;
- my $maindir = $vars{'from_dvd'} ? 'TEXDIRW' : 'TEXDIR';
-
$vars{'n_systems_selected'}=0;
$vars{'n_collections_selected'}=0;
foreach my $key (keys %vars) {
@@ -933,9 +949,9 @@ sub main_menu {
'I' => \&do_install,
'O' => \&options_menu,
'Q' => \&quit,
- 'V' => \&dvd_hd_toggle,
+ 'V' => \&toggle_portable,
);
- if (!$vars{'from_dvd'}) {
+ if (!$vars{'in_place'}) {
$command{'B'} = \&binary_menu if unix();
$command{'C'} = \&collection_menu;
$command{'L'} = \&language_menu;
@@ -949,12 +965,12 @@ sub main_menu {
=======> Note: Letters/digits in <angle brackets> indicate menu items <=======
=======> for commands or configurable options <=======
+ Detected platform: $this_platform
+ $warn_nobin
EOF
- if (!$vars{'from_dvd'}) {
+ if (!$vars{'in_place'}) {
print <<"EOF";
- Detected platform: $this_platform
- $warn_nobin
<B> platforms: $vars{'n_systems_selected'} out of $vars{'n_systems_available'}
<S> installation scheme ($vars{'selected_scheme'})
@@ -969,23 +985,17 @@ EOF
print " !! No language specific collection selected!\n";
print " !! If you only write American English documents that is fine!\n";
}
-
+ }
print <<"EOF";
<D> directories:
TEXDIR (the main TeX directory):
EOF
- } else { # $vars{'from_dvd'}
- print <<"EOF";
- <D> directories:
- TEXDIRW (Writable root):
-EOF
- }
- if (TeXLive::TLUtils::texdir_check($vars{$maindir})) {
- print " $vars{$maindir}\n";
+ if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
+ print " $vars{'TEXDIR'}\n";
} else {
- print " !! default location: $vars{$maindir}\n";
+ print " !! default location: $vars{'TEXDIR'}\n";
print " !! is not writable, please select a different one!\n";
}
print <<"EOF";
@@ -1011,32 +1021,32 @@ print <<"EOF";
$b_fmt create all format files
EOF
- if (!$vars{'from_dvd'}) {
+ if (!$vars{'in_place'}) {
if ($vars{'doc_splitting_supported'}) {
print " $b_doc install macro/font doc tree\n";
}
if ($vars{'src_splitting_supported'}) {
print " $b_src install macro/font source tree\n";
}
- if (win32()) {
+ }
+ if (win32()) {
+ if (!$vars{'portable'}) {
print " $b_path adjust search path\n";
print " $b_deskint add menu items, shortcuts, etc.\n";
print " [$vars{'option_file_assocs'}] update file associations\n";
if (admin()) {
print " $b_admin make installation available to all users\n";
}
- print" $b_addoneditor install TeXworks front end\n";
- } else {
- print " $b_path create symlinks to standard directories\n";
}
+ print " $b_addoneditor install TeXworks front end\n";
+ print " $b_path create symlinks to standard directories\n" unless
+ ($vars{'portable'} || win32());
}
- if (member('local_uncompressed', @media_available)) {
- if ($vars{'from_dvd'}) {
- print "\n <V> set up for installing to hard disk\n";
- } else {
- print "\n <V> set up for running from DVD\n";
- }
+ if ($vars{'portable'}) {
+ print "\n <V> set up for regular installation to hard disk\n";
+ } else {
+ print "\n <V> set up for portable installation\n";
}
other_options qw(I H Q);