#!/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 if ($::opt_no_cls); (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=); 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"; 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) { next if ($collection eq 'collection-perl'); my $tlpobj = $tlpdb->get_package("$collection"); if (length $tlpobj->shortdesc>30) { push @coll_long_desc, $collection; } else { push @coll_short_desc, $collection; } } my $singlecolumn_index=@coll_short_desc-1; ## my $lines=@coll_short_desc/2; ++$lines if (@coll_short_desc%2); for (0..$lines-1) { $index=$_; my $collection=$coll_short_desc[$index]; my $tlpobj = $tlpdb->get_package("$collection"); $keyval{$keys[$index]}="$collection"; printf " %s %s %-33s", $keys[$index], button($vars{"$collection"}), substr($tlpobj->shortdesc,0,33); if (defined $coll_short_desc[$index+$lines]) { my $collection=$coll_short_desc[$index+$lines]; my $tlpobj=$tlpdb->get_package("$collection"); $keyval{$keys[$index+$lines]}="$collection"; printf " %s %s %-32s\n", $keys[$index+$lines], button($vars{"$collection"}), substr($tlpobj->shortdesc,0,32); } else { print "\n"; } } ## $index=$singlecolumn_index; # print "\n$index\n\n"; foreach my $collection (@coll_long_desc) { my $tlpobj=$tlpdb->get_package("$collection"); $keyval{$keys[$index+1]}="$collection"; printf " %s %s %s\n", $keys[$index+1], button($vars{"$collection"}), $tlpobj->shortdesc; ++$index; } ## other_options qw(- + R Q); 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 %-32s\n", $lang_keys[$index+$lines], button($vars{"$language"}), substr($tlpobj->shortdesc,0,32); } 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 %-32s\n", $lang_doc_keys[$index+$lines], button($vars{"$lang_doc"}), substr($tlpobj->shortdesc,0,32); } 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 ; 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 TEXDIR [$vars{'TEXDIR'}]: "; chomp($answer=); $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=); $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=); $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=); $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'}->(); } } $vars{'page'}=0; sub html2text { my $filename=shift; my @text; open IN, "$filename"; @all_lines=; close IN; chomp @all_lines; my $itemcnt; my $ordered_list=0; my $h1_indent=25; my $h2_indent=3; my $h3_indent=6; for (@all_lines) { next if /DOCTYPE/; next if /