diff options
author | Norbert Preining <preining@logic.at> | 2007-12-01 21:51:38 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-12-01 21:51:38 +0000 |
commit | 39cd253813784764ace38932299ee9274b79104b (patch) | |
tree | f700cc04d48f2539c1d3b87b4c0d5b535f88ca0b /Master/tlpkg | |
parent | 27b8adaf50eb3cb5a25cfcdd39e30c2b2fc7a16c (diff) |
move the menu implementation into tlpkg/TeXLive/
git-svn-id: svn://tug.org/texlive/trunk@5666 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg')
-rwxr-xr-x | Master/tlpkg/TeXLive/install-menu-text.pl | 716 |
1 files changed, 716 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/install-menu-text.pl b/Master/tlpkg/TeXLive/install-menu-text.pl new file mode 100755 index 00000000000..a2d5f898aea --- /dev/null +++ b/Master/tlpkg/TeXLive/install-menu-text.pl @@ -0,0 +1,716 @@ +#!/usr/bin/env perl + +# $Id$ +# install-menu-txt.pl +# +# Copyright 2007 Reinhard Kotucha, Norbert Preining +# 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. +# + +our %vars; +our $tlpdb; +our @collections_std; +our @collections_lang; +our @collections_lang_doc; +our $texlive_release; +our $trynet; +our $max_bins_on_CD; + +my $MENU_CONTINUE = -1; +our $MENU_INSTALL = 0; +our $MENU_ABORT = 1; +our $MENU_QUIT = 2; + + +my $RETURN = $MENU_CONTINUE; + +sub clear_screen { +# return 0; + (unix)? system 'clear':system '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; + my $val=$vars{$var}; + ++$val; + $vars{$var}=$val%2;; +} + +sub menu_head { + my $text=shift; + clear_screen; + print "$text\n", hbar, "\n"; +} + +sub other_options { + my @options=@_; + my %opts=( + '-' => 'deselect all', + '+' => 'select all', + 'H' => 'help', + 'I' => 'start installation', + 'N' => 'add binaries from net', + 'R' => 'return to main menu', + 'Q' => 'quit' + ); + + print "\nOther options:\n", hbar; + 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: "; + chomp(my $answer=<STDIN>); + 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 { + my $menu=\&main_menu; + while ($RETURN == $MENU_CONTINUE) { + $menu=$menu->(); + } + return($RETURN); +} + + +sub binary_menu { + my %command=( + 'self' => \&binary_menu, + 'R' => \&main_menu, + 'Q' => \&quit + ); + + my @diskbins; + my @netbins; + my %from_net; + my @keys=string_to_list "abcdefghijklmopstuvwxyz"; + my $index=0; + my $diskbin=''; + my %keyval; + my $selected_platform; + + menu_head "Available sets of binaries:"; + + foreach my $key (keys %vars) { + if ($key=~/diskbin_(.*)/) { + push @diskbins, $1; + $from_net{"$1"}=0; + } + if ($key=~/netbin_(.*)/) { + push @netbins, $1; + $from_net{"$1"}=1; + } + } + my @binaries=sort(@diskbins,@netbins); + + set_install_platform; + + $vars{'n_systems_available'}=0; + for my $key (keys %vars) { + ++$vars{'n_systems_available'} if ($key=~/^(disk|net)bin/); + } + + $diskbin=' ' + if (media eq 'CD' and $vars{'n_systems_available'}>$max_bins_on_CD); + + foreach my $binary (@binaries) { + if (media eq 'CD' and $vars{'n_systems_available'}>$max_bins_on_CD) { + $diskbin=$from_net{"$binary"}? "* ":" "; + } + printf " %s %s %s%-16s %s\n", $keys[$index], + button($from_net{"$binary"}? + $vars{"netbin_$binary"}:$vars{"diskbin_$binary"}), + $diskbin, "$binary" . ":", + platform_desc "$binary"; + $keyval{"$keys[$index]"}=$from_net{"$binary"}? + "netbin_$binary":"diskbin_$binary"; + ++$index; + } + if ($vars{'n_systems_available'}<=$max_bins_on_CD ) { + print "\n Binaries for additional systems are available on the DVD.\n" . + " If you have network access, try option <N>.\n"; + + other_options qw(- + N R Q); + } else { + print "\n Network access is required to install binary systems " . + "marked with '*'.\n" if (media eq 'CD'); + + other_options qw(- + R Q); + } + + my $answer=prompt 'Press key to select/deselect binary systems'; + + my @keystrokes=string_to_list $answer; + + foreach my $keystroke (@keystrokes) { + if ($keystroke eq '-') { + for my $binary (@binaries) { + $vars{"netbin_$binary"}=0 if defined $vars{"netbin_$binary"}; + $vars{"diskbin_$binary"}=0 if defined $vars{"diskbin_$binary"}; + } + } + if ($keystroke eq '+') { + for my $binary (@binaries) { + $vars{"netbin_$binary"}=1 if defined $vars{"netbin_$binary"}; + $vars{"diskbin_$binary"}=1 if defined $vars{"diskbin_$binary"}; + } + } + if (defined $keyval{$keystroke}) { + toggle "$keyval{$keystroke}"; + } + } + if ("\u$answer" eq 'N' and media eq 'CD') { + $trynet=1; + set_platforms_supported; + $trynet=0; + return $command{'self'}; + } + 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 a scheme:'; + + 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; + + foreach my $scheme (@schemes) { + $keyval{$keys[$index]}="$scheme"; + my $tlpobj = $tlpdb->get_package("$scheme"); + printf " %s %s %s\n", $keys[$index], button($vars{"$scheme"}), + $tlpobj->shortdesc; + ++$index; + } + + foreach my $entry (keys %vars) { + if ($entry=~/^(collection-.*)/) { + $vars{"$1"}=0; + } + } + + my $scheme_tlpobj = $tlpdb->get_package($vars{'selected_scheme'}); + if (defined ($scheme_tlpobj)) { + foreach my $dependent ($scheme_tlpobj->depends) { + if ($dependent=~/^(collection-.*)/) { + $vars{"$1"}=1; + } + } + } + + other_options qw(R Q); + my $answer=prompt 'Press key to select a scheme'; + + if (defined $keyval{"$answer"}) { + $vars{'selected_scheme'}=$keyval{"$answer"}; + return $command{'self'}->(); + } + if (defined $command{"\u$answer"}) { + return $command{"\u$answer"}->(); + } else { + 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) { + 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); + my $answer=prompt 'Press key to select collections'; + + 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}"; + } + } + + if (defined $command{"\u$answer"}) { + 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 'Select languages:'; + + @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 %-33s\n", $lang_keys[$index+$lines], + button($vars{"$language"}), substr($tlpobj->shortdesc,0,33); + } else { + print "\n"; + } + } + + print "\nLanguage specific documentation. Select languages first.\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 %-33s\n", $lang_doc_keys[$index+$lines], + button($vars{"$lang_doc"}), substr($tlpobj->shortdesc,0,33); + } else { + print "\n"; + } + } + + other_options qw (+ - R Q); + my $answer=prompt 'Press key to select language'; + + 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}"; + } + } + + if (defined $keyval{"$answer"}) { + $vars{'selected_scheme'}=$keyval{"$answer"}; + return $command{'self'}->(); + } + if (defined $command{"\u$answer"}) { + return $command{"\u$answer"}->(); + } else { + return $command{'self'}->(); + } +} + + +sub directories_menu { + my %command=( + 'self' => \&directories_menu, + 'R' => \&main_menu, + 'Q' => \&quit + ); + + menu_head "Current directories setup:"; + print <<"EOF"; + <1> TEXDIR: $vars{'TEXDIR'} + support tree: $vars{'TEXDIR'}/texmf + + <2> TEXMFLOCAL: $vars{'TEXMFLOCAL'} + <3> TEXMFSYSVAR: $vars{'TEXMFSYSVAR'} + <4> TEXMFHOME: $vars{'TEXMFHOME'} +EOF +; + + other_options qw (R Q); + my $answer=prompt 'Enter command'; + + if ("\u$answer" eq '1') { + print "New value TEXDIR [$vars{'TEXDIR'}]: "; + chomp($answer=<STDIN>); + $vars{'TEXDIR'}="$answer" if (length $answer); + $vars{'TEXDIR'}=~s@\\@/@g if (win32); + if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { + $vars{'TEXMFLOCAL'}="$1/texmf-local"; + $vars{'TEXMFSYSVAR'}="$1/$texlive_release/texmf-var"; + return $command{'self'}; + } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { + $vars{'TEXMFLOCAL'}="$1/texmf-local"; + $vars{'TEXMFSYSVAR'}="$1/texmf-var"; + return $command{'self'}; + } + } + if ("\u$answer" eq '2') { + print "New value TEXMFLOCAL [$vars{'TEXMFLOCAL'}]: "; + chomp($answer=<STDIN>); + $vars{'TEXMFLOCAL'}="$answer" if (length $answer); + $vars{'TEXMFLOCAL'}=~s@\\@/@g if (win32); + return $command{'self'}; + } + if ("\u$answer" eq '3') { + print "New value TEXMFSYSVAR [$vars{'TEXMFSYSVAR'}]: "; + chomp($answer=<STDIN>); + $vars{'TEXMFSYSVAR'}="$answer" if (length $answer); + $vars{'TEXMFSYSVAR'}=~s@\\@/@g if (win32); + return $command{'self'}; + } + if ("\u$answer" eq '4') { + print "New value TEXMFHOME [$vars{'TEXMFHOME'}]: "; + chomp($answer=<STDIN>); + $vars{'TEXMFHOME'}="$answer" if (length $answer); + $vars{'TEXMFHOME'}=~s@\\@/@g if (win32); + return $command{'self'}; + } + + if (defined $command{"\u$answer"}) { + return $command{"\u$answer"}->(); + } else { + return $command{'self'}->(); + } +} + + +sub options_menu { + my $b_symlinks=button($vars{'option_symlinks'}); + 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 $sys_bin=$vars{'sys_bin'}; + my $sys_man=$vars{'sys_man'}; + my $sys_info=$vars{'sys_info'}; + + my $t_sys_bin=($vars{'option_symlinks'})? $vars{'sys_bin'}:''; + my $t_sys_man=($vars{'option_symlinks'})? $vars{'sys_man'}:''; + my $t_sys_info=($vars{'option_symlinks'})? $vars{'sys_info'}:''; + + my %command=( + 'self' => \&options_menu, + 'R' => \&main_menu, + 'Q' => \&quit + ); + + clear_screen; + menu_head "Current options setup:"; + + print <<"EOF"; + <P> use letter size instead of A4 by default: $b_letter + <F> create all format files: $b_fmt + <D> install font/macro doc tree: $b_doc + <S> install font/macro source tree: $b_src +EOF +; + if (unix) { + print <<"EOF"; + <L> create symlinks in standard directories: $b_symlinks + binaries to: $t_sys_bin + manpages to: $t_sys_man + info to: $t_sys_info +EOF +; + } + other_options qw(R Q); + my $answer=prompt 'Enter command'; + + if (unix) { + if ("\u$answer" eq 'L') { + toggle 'option_symlinks'; + if ($vars{'option_symlinks'}) { + print "New value for binary directory [$sys_bin]: "; + chomp($answer=<STDIN>); + $vars{'sys_bin'}="$answer" if (length $answer); + + if ($vars{'sys_bin'}=~/^(.*)\/bin$/) { + $vars{'sys_man'}="$1/man"; + $vars{'sys_info'}="$1/info"; + } + print "New value for man directory [$vars{'sys_man'}]: "; + chomp($answer=<STDIN>); + $vars{'sys_man'}="$answer" if (length $answer); + + print "New value for info directory [$vars{'sys_info'}]: "; + chomp($answer=<STDIN>); + $vars{'sys_info'}="$answer" if (length $answer); + } + return $command{'self'}; + } + } + if ("\u$answer" eq 'P') { + toggle 'option_letter'; + return $command{'self'}; + } + if ("\u$answer" eq 'F') { + toggle 'option_fmt'; + return $command{'self'}; + } + if ("\u$answer" eq 'S') { + toggle 'option_src'; + return $command{'self'}; + } + if ("\u$answer" eq 'S') { + toggle 'option_src'; + return $command{'self'}; + } + if ("\u$answer" eq 'D') { + toggle 'option_doc'; + return $command{'self'}; + } + if (defined $command{"\u$answer"}) { + return $command{"\u$answer"}; + } else { + return $command{'self'}; + } +} + + +sub quit { + $RETURN = $MENU_QUIT; +} + +sub do_install { + $RETURN = $MENU_INSTALL; +} + +sub main_menu { + my $this_platform=platform_desc($vars{'this_platform'}); + + my $b_symlinks=button($vars{'option_symlinks'}); + 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 $warn_nobin; + + $vars{'n_systems_available'}=0; + for my $key (keys %vars) { + ++$vars{'n_systems_available'} if ($key=~/^(disk|net)bin/); + } + + $warn_nobin=set_install_platform; + + $vars{'n_systems_selected'}=0; + $vars{'n_collections_selected'}=0; + foreach my $key (keys %vars) { + if ($key=~/^diskbin.*/ or $key=~/^netbin.*/) { + ++$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, + 'P' => \&platform_menu, + 'O' => \&options_menu, + 'I' => \&do_install, + 'C' => \&collection_menu, + 'L' => \&language_menu, + 'D' => \&directories_menu, + 'S' => \&scheme_menu, + 'B' => \&binary_menu, + 'Q' => \&quit + ); + + clear_screen; + + print <<"EOF"; +======================> TeX Live installation procedure <===================== + +=======> Note: Letters/digits in <angle brackets> indicate menu items <======= +=======> for commands or configurable options <======= + + Proposed platform: $this_platform + $warn_nobin + <B> binary systems: $vars{'n_systems_selected'} out of $vars{'n_systems_available'} + + <S> Installation scheme ($vars{'selected_scheme'}) + + Customizing installation scheme: + <C> standard collections + <L> language collections + $vars{'n_collections_selected'} collections out of $vars{'n_collections_available'}, disk space required: $vars{'total_size'} MB + + <D> directories: + TEXDIR (The main TeX directory) : $vars{'TEXDIR'} + TEXMFLOCAL (Directory for local styles etc): $vars{'TEXMFLOCAL'} + TEXMFSYSVAR (Directory for local config) : $vars{'TEXMFSYSVAR'} + + <O> options: +EOF +; +print <<"EOF"; + $b_letter use letter size instead of A4 by default + $b_fmt create all format files + $b_doc install macro/font doc tree + $b_src install macro/font source tree +EOF +; + print <<"EOF" if (unix); + $b_symlinks create symlinks in standard directories +EOF +; + + other_options qw (I H Q); + my $answer=prompt 'Enter command'; + +# chomp(my $answer=<STDIN>); + if (defined $command{"\u$answer"}) { + return $command{"\u$answer"}; + } else { + 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: # |