path: root/Master/tlpkg/installer/install-menu-perltk.pl

#!/usr/bin/env perl
#
# $Id$
#
# Copyright 2008 Norbert Preining, Reinhard Kotucha
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
#
# TODO:
# - does the DoOneEvent *NEVER* hang???
# - translation into other languages

my $svnrev = '$Revision$';
$svnrev =~ m/: ([0-9]+) /;
$::menurevision = $1;


our %vars;
our $tlpdb;
our @collections_std;
our @collections_lang;
our @collections_lang_doc;
our $texlive_release;
our $trynet;
our $max_bins_on_CD;

our $MENU_INSTALL = 0;
our $MENU_ABORT   = 1;
our $MENU_QUIT    = 2;
our $MENU_ALREADYDONE = 3;

my $return = $MENU_INSTALL;

require Tk;
require Tk::Dialog;
require Tk::PNG;
require Encode;

my $mw;

my $bintextbutton;
my $schemebutton;
my $collectionstext;
my $texmflocaltext;
my $texmfsysvartext;
my $texdirtext;
my $symlinktext;
my $optletterstate;
my $optfmtstate;
my $optsrcstate;
my $optdocstate;

push @::start_install_hook, sub { update_statusbar("Starting Installation");
  Tk::DoOneEvent(Tk::Event::DONT_WAIT); Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::start_postinst_hook, sub { update_statusbar("Starting Post Installation Jobs");
  Tk::DoOneEvent(Tk::Event::DONT_WAIT); Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::end_install_hook, sub { update_statusbar("Installation finished");
  Tk::DoOneEvent(Tk::Event::DONT_WAIT); Tk::DoOneEvent(Tk::Event::DONT_WAIT); };


push @::install_packages_hook, \&update_statusbar;
# no idea how many of those are necessary, 1 is definitely not enough!
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };
push @::install_packages_hook, sub { Tk::DoOneEvent(Tk::Event::DONT_WAIT); };

sub update_statusbar {
  my $p = shift;
  $::statusbar->configure(-text => "$p");
}

my %encodings = (
     de  =>  'latin1',
     pl  =>  'latin2',
  );

# if windows has a different encoding than the one given above
my %special_win_encodings = (
     pl  =>  'cp1250',
  );

my %text = ( title      => 'TeX Live 2008 Installation',
             basicinfo  => 'Basic Information',
             custom     => 'Further Customization',
             dirsetup   => "Directories' setup",
             options    => 'Options',
             sysint     => 'System Integration',
             change     => 'Change',
             toggle     => 'Toggle',
             install    => 'Install TeX Live',
             finished   => 'Installation finished',
             finbut     => 'Finish',
             quit       => 'Quit',
             ok         => 'Ok',
             cancel     => 'Cancel',
             status     => 'Status output',
             changevar  => 'Change variable value',
             enterpath  => 'Enter path for',
             selectscheme => 'Select Scheme',
             selectstdcol => 'Select the collections to be installed',
             selectall  => 'Select All',
             selectnone => 'Deselect All',
             selectlang => 'Language Selection',
             selectdoc  => 'Doc/Language Selection',
             createsym  => 'create symlinks in standard directories',
             binto      => 'binaries to',
             manto      => 'manpages to',
             infoto     => 'info to',
             onnet      => 'On Net',
             ondisk     => 'On Disk',
             selectsys  => 'Select arch-os',
             clicknetbin => 'Click for net bins',
             outof      => 'out of',
             collof     => 'collections out of',
             diskreq    => 'disk space required',
             yes        => 'Yes',
             no         => 'No',
    );


my %labels = ( binsys   => 'Binary System(s)',
               scheme   => 'Selected Scheme',
               stdcoll  => 'Standard Collections',
               langcoll => 'Language Collections',
               texdir   => 'TEXDIR (main TeX directory)',
               localdir => 'TEXMFLOCAL (local styles etc)',
               sysvardir   => 'TEXMFSYSVAR (local config)',
               optletter => 'Use letter instead of A4 by default',
               optfmt   => 'Create all format files',
               optdoc   =>  'Install font/macro doc tree',
               optsrc   =>  'Install font/macro source tree',
               symlink  =>  'Install symlinks to system directories',
    );

if (($::lang ne "en") && ($::lang ne "C")) {
  if (! -r "$::installerdir/tlpkg/installer/lang/perltk-$::lang") {
  #eval { require("installer/lang/perltk-$::lang.pl"); };
  #if ($@) {
    # couldn't find the file, continue with english
    warn "Couldn't find language file installer/lang/perltk-$::lang.pl: $!\nContinuing in English!\n";
  } else {
    # merge the translated strings into the text string
    my $destenc = "latin1";
    $destenc = $encodings{$::lang} if defined($encodings{$::lang});
    $destenc = $special_win_encodings{$::lang} 
      if defined($special_win_encodings{$::lang});
    $destenc = $::charset if defined($::charset);
    tllog($::LOG_DEBUG, "lang/charset settings: lang=$::lang, charset=$destenc\n");
    open(LANG,"<$::installerdir/tlpkg/installer/lang/perltk-$::lang");
    my %trans;
    while (<LANG>) {
      chomp;
      next if m/^\s*#/;
      next if m/^\s*$/;
      my ($a,$b) = split(/:/,$_);
      $b =~ s/^\s*([^\s])/$1/;
      $b =~ s/\s*$//;
      Encode::from_to($b, "utf8", $destenc);
      $trans{"$a"} = "$b";
    }
    close(LANG);
    foreach my $k (keys %text) {
      $text{$k} = $trans{"text.$k"} if defined($trans{"text.$k"});
    }
    foreach my $k (keys %labels) {
      $labels{$k} = $trans{"label.$k"} if defined($trans{"label.$k"});
    }
  }
}

my $letteryesno = $text{'no'};
my $fmtyesno = $text{'no'};
my $srcyesno = $text{'yes'};
my $docyesno = $text{'yes'};

sub run_menu {
  # computing $a:
  my $a = 0;
  foreach my $l (keys %labels) {
    my $l = length($labels{$l});
    $a = $l if ($l > $a);
  }
  # add one char width for spacing
  $a++;
  my $b = 35;
  if (win32()) {
    $b = 30;
  }
  # computation of $c
  my $c = 0;
  foreach my $l (qw/change toggle/) {
    my $l = length($text{$l});
    $c = $l if ($l > $c);
  }
  tllog($::LOG_DDEBUG, "setting column widhts to a=$a, c=$c\n");
  calc_depends;
  $mw = MainWindow->new;

  # image frame on the left
  my $fl = $mw->Frame;
  my $img = $fl->Photo(-format => 'png', -file => "tlpkg/installer/texlive2008.png");
  $fl->Label(-image => $img)->pack;
  $fl->Label(-text => "v$::installerrevision/$::menurevision"))->pack;

  # data frame on the right
  my $fr = $mw->Frame;
  $fl->pack(-side => 'left');
  $fr->pack(-side => 'right');
  $fr->Label(-text => $text{'title'})->pack;
  $fr->Label(-text => "------- $text{'basicinfo'} -------")->pack;

  # binary system line
  my $fbin = $fr->Frame; $fbin->pack;
  $fbin->Label(-text => $labels{'binsys'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $bintextbutton = $fbin->Label(-width => $b, -anchor => 'w'); $bintextbutton->pack(-side => 'left');
  $fbin->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_select_binsystems(); })->pack(-side => 'left');

  # scheme line
  my $fscheme = $fr->Frame; $fscheme->pack;
  $fscheme->Label(-text => $labels{'scheme'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $schemebutton = $fscheme->Label(-width => $b, -anchor => 'w'); $schemebutton->pack(-side => 'left');
  $fscheme->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_select_scheme(); })->pack(-side => 'left');

  # further customization
  $fr->Label(-text => "------- $text{'custom'} -------")->pack;

  # standard collection line
  my $fcoll = $fr->Frame; $fcoll->pack;
  $fcoll->Label(-text => $labels{'stdcoll'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $fcoll->Label(-width => $b)->pack(-side => 'left');
  $fcoll->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_select_standard_collections(); })->pack(-side => 'left');

  # lang collection line
  my $flang = $fr->Frame; $flang->pack;
  $flang->Label(-text => $labels{'langcoll'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $flang->Label(-width => $b)->pack(-side => 'left');
  $flang->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_select_lang_collections(); })->pack(-side => 'left');

  $collectionstext = $fr->Label();
  $collectionstext->pack;

  # further customization
  $fr->Label(-text => "------- $text{'dirsetup'} -------")->pack;
  
  # texdir line
  my $ftexdir = $fr->Frame; $ftexdir->pack;
  $ftexdir->Label(-text => $labels{'texdir'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $texdirtext = $ftexdir->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
  $ftexdir->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_edit_vars_value("TEXDIR"); })->pack(-side => 'left');

  # texmflocal line
  my $flocal = $fr->Frame; $flocal->pack;
  $flocal->Label(-text => $labels{'localdir'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $texmflocaltext = $flocal->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
  $flocal->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_edit_vars_value("TEXMFLOCAL"); })->pack(-side => 'left');

  # texmflocal line
  my $fsys = $fr->Frame; $fsys->pack;
  $fsys->Label(-text => $labels{'sysvardir'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $texmfsysvartext = $fsys->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
  $fsys->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_edit_vars_value("TEXMFSYSVAR"); })->pack(-side => 'left');


  # Options
  $fr->Label(-text => "------- $text{'options'} -------")->pack;

  # optpaper
  my $fletter = $fr->Frame; $fletter->pack;
  $fletter->Label(-text => $labels{'optletter'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $fletter->Label(-width => $b, -anchor => 'w', -textvariable => \$letteryesno)->pack(-side => 'left');
  $fletter->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_letter'}, \$letteryesno); })->pack(-side => 'left');
  
  my $ffmt = $fr->Frame; $ffmt->pack;
  $ffmt->Label(-text => $labels{'optfmt'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $ffmt->Label(-width => $b, -anchor => 'w', -textvariable => \$fmtyesno)->pack(-side => 'left');
  $ffmt->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_fmt'}, \$fmtyesno); })->pack(-side => 'left');
  
  my $fdoc = $fr->Frame; $fdoc->pack;
  $fdoc->Label(-text => $labels{'optdoc'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $fdoc->Label(-width => $b, -anchor => 'w', -textvariable => \$docyesno)->pack(-side => 'left');
  $fdoc->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_doc'}, \$docyesno); })->pack(-side => 'left');
  
  my $fsrc = $fr->Frame; $fsrc->pack;
  $fsrc->Label(-text => $labels{'optsrc'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
  $fsrc->Label(-width => $b, -anchor => 'w', -textvariable => \$srcyesno)->pack(-side => 'left');
  $fsrc->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_src'}, \$srcyesno); })->pack(-side => 'left');
  
  if (unix()) {
    # Symlinks
    $fr->Label(-text => "------- $text{'sysint'} -------")->pack;
    
    my $fsym = $fr->Frame; $fsym->pack;
    $fsym->Label(-text => $labels{'symlink'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
    $symlinktext = $fsym->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
    $fsym->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_select_symlink(); })->pack(-side => 'left')
  }

  # install/cancel buttons
  my $f3 = $fr->Frame;
  $f3->Button(
    -text    => $text{'install'},
    -command => sub { do_installation(); 
      $return = $MENU_ALREADYDONE;
      $fr->Dialog(-text => $text{'finished'}, -buttons => [ $text{'finbut'} ])->Show;
      $mw->destroy },
  )->pack(-side => 'left');
  $f3->Button(
    -text    => $text{'quit'},
    -command => sub { $return = $MENU_ABORT; $mw->destroy }
  )->pack(-side => 'right');
  $f3->pack(-expand => 'x');
  $::statusbar = $fr->Label(-text => $text{'status'});
  $::statusbar->pack;
  menu_update_texts();
  Tk::MainLoop();
  return($return);
}

sub menu_edit_vars_value {
  my $key = shift;
  my $sw = $mw->Toplevel(-title => $text{'changevar'});
  my $val = $vars{$key};
  $sw->Label(-text => $text{'enterpath'} . " $key:")->pack;
  my $entry = $sw->Entry(-textvariable => $val, -width => 60);
  $entry->pack;
  my $f = $sw->Frame;
  $f->Button(-text => $text{'ok'}, 
     -command => sub { $val = $entry->get; callback_edit_directories($key,$val) ; $sw->destroy })->pack(-side => 'left');
  $f->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
  $f->pack(-expand => 'x');
}
    
sub menu_select_scheme {
  my $sw = $mw->Toplevel(-title => $labels{'scheme'});
  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;
  my $selected = $vars{'selected_scheme'};
  $sw->Label(-text => $text{'selectscheme'})->pack;
  my $f2 = $sw->Frame;
  my $f2l = $f2->Frame;
  my $f2r = $f2->Frame;
  my $nrfh = $#schemes / 2;
  my $i = 0;
  foreach my $scheme (@schemes) {
    my $tlpobj = $tlpdb->get_package("$scheme");
    if ($i < $nrfh) {
      $f2l->Radiobutton(-variable => \$selected, -value => $scheme,
        -text => $tlpobj->shortdesc)->pack(-anchor => 'w');
    } else {
      $f2r->Radiobutton(-variable => \$selected, -value => $scheme,
        -text => $tlpobj->shortdesc)->pack(-anchor => 'w');
    }
    $i++;
  }
  $f2l->pack(-side => 'left');
  $f2r->pack(-side => 'right');
  $f2->pack;
  my $f3 = $sw->Frame;
  $f3->Button(-text => $text{'ok'}, 
     -command => sub { callback_select_scheme($selected) ; $sw->destroy })->pack(-side => 'left');
  $f3->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
  $f3->pack(-expand => 'x');
}

sub menu_select_standard_collections {
  my $sw = $mw->Toplevel(-title => $labels{'stdcoll'});
  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 => $text{'selectstdcol'})->pack;
  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');
  $f2->pack(-side => 'right');
  $fb->pack;
  $fd->pack(-expand => 'x');
  $fd->Button(-text => $text{'selectall'},
    -command => sub { select_collections(\%lvars, @collections_std) })->pack(-side => 'left');
  $fd->Button(-text => $text{'selectnone'},
    -command => sub { deselect_collections(\%lvars, @collections_std) })->pack(-side => 'right');
  $fc->pack(-expand => 'x');
  $fc->Button(-text => $text{'ok'}, 
     -command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left');
  $fc->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
}

sub menu_select_lang_collections {
  my $sw = $mw->Toplevel(-title => $labels{'langcoll'});
  my $f1 = $sw->Frame;
  $f1->pack;
  my $f1lang = $f1->Frame;
  my $f1doc  = $f1->Frame;
  $f1lang->pack(-side => 'left');
  $f1doc->pack(-side => 'right');
  my $f1langT = $f1lang->Frame; $f1langT->pack;
  my $f1langL = $f1lang->Frame; $f1langL->pack;
  $f1langT->Label(-text => $text{'selectlang'})->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 => $text{'selectall'},
    -command => sub { select_collections(\%lvars, @collections_lang) })->pack(-side => 'left');
  $f1langB->Button(-text => $text{'selectnone'},
    -command => sub { deselect_collections(\%lvars, @collections_lang) })->pack(-side => 'right');
  
  my $f1docT = $f1doc->Frame; $f1docT->pack;
  my $f1docL = $f1doc->Frame; $f1docL->pack;
  $f1docT->Label(-text => $text{'selectdoc'})->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 => 'x');
  $f1docB->Button(-text => $text{'selectall'},
    -command => sub { select_collections(\%lvars, @collections_lang_doc) })->pack(-side => 'left');
  $f1docB->Button(-text => $text{'selectnone'},
    -command => sub { deselect_collections(\%lvars, @collections_lang_doc) })->pack(-side => 'right');
  my $f2 = $sw->Frame; $f2->pack(-expand => 'x');
  $f2->Button(-text => $text{'ok'}, 
     -command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left');
  $f2->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
}

sub menu_select_symlink {
  our ($lbin,$lman,$linfo);
  our $osym = $vars{'option_symlinks'};
  sub set_unset_buttons {
    $lbin = ($osym ? $vars{'sys_bin'} : '');
    $linfo = ($osym ? $vars{'sys_info'} : '');
    $lman = ($osym ? $vars{'sys_man'} : '');
  }
  sub return_callback {
    if ($osym) {
      $vars{'sys_bin'} = $lbin;
      $vars{'sys_info'} = $linfo;
      $vars{'sys_man'} = $lman;
    } 
    $vars{'option_symlinks'} = $osym;
    menu_update_texts();
  }
  set_unset_buttons();
  my $sw = $mw->Toplevel(-title => $labels{'symlink'});
  $sw->Checkbutton(-variable => \$osym, 
                   -text => $text{'createsym'},
		   -command => sub { set_unset_buttons(); } )->pack;
  my $fbin = $sw->Frame;
  $fbin->Label(-text => $text{'binto'})->pack(-side => 'left');
  my $binb = $fbin->Entry(-textvariable => \$lbin, -width => 30);
  $binb->pack(-side => 'right');
  $fbin->pack(-expand => 'x');
  my $fman = $sw->Frame;
  $fman->Label(-text => $text{'manto'})->pack(-side => 'left');
  my $manb = $fman->Entry(-textvariable => \$lman, -width => 30);
  $manb->pack(-side => 'right');
  $fman->pack(-expand => 'x');
  my $finfo = $sw->Frame;
  $finfo->Label(-text => $text{'infoto'})->pack(-side => 'left');
  my $infob = $finfo->Entry(-textvariable => \$linfo, -width => 30);
  $infob->pack(-side => 'right');
  $finfo->pack(-expand => 'x');
  my $f2 = $sw->Frame; $f2->pack(-expand => 'x');
  $f2->Button(-text => $text{'ok'}, 
     -command => sub { return_callback(); $sw->destroy })->pack(-side => 'left');
  $f2->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
}

sub menu_select_binsystems {
  our $f2r;
  our $f2;
  our @netarchs = ();
  sub update_net_archs() {
    my $oldnrnetarch = $#netarchs;
    $trynet = 1;
    set_platforms_supported();
    $trynet=0;
    @netarchs = ();
    foreach my $key (keys %vars) {
      if ($key=~/netbin_(.*)/) {
        push @netarchs, $1;
	$from_net{"$1"}=1;
      }
    }
    menu_update_texts();
    if ($#netarchs != $oldnrnetarch) {
      # we have to destroy the old $f2r frame and make a new one
      $f2r->destroy;
      do_net_frame();
    }
  }
  sub do_net_frame {
    $f2r = $f2->Frame;
    if ($#netarchs >= 0) {
      $f2r->Label(-text => $text{'onnet'})->pack;
      foreach my $sys (sort @netarchs) {
        $f2r->Checkbutton(-variable => \$vars{"netbin_$sys"}, -text => "$sys")->pack(-anchor => 'w');
      }
      $f2r->pack(-side => 'right');
    }
    $f2->pack;
  }
  my $sw = $mw->Toplevel(-title => $labels{'binsys'});
  my @diskarchs = ();
  foreach my $key (keys %vars) {
    if ($key=~/diskbin_(.*)/) {
      push @diskarchs, $1;
      $from_net{"$1"}=0;
    }
    if ($key=~/netbin_(.*)/) {
      push @netarchs, $1;
      $from_net{"$1"}=1;
    }
  }
  $sw->Label(-text => $text{'selectsys'})->pack;
  $f2 = $sw->Frame;
  my $f2l = $f2->Frame;
  $f2l->Label(-text => $text{'ondisk'})->pack;
  foreach my $sys (sort @diskarchs) {
    $f2l->Checkbutton(-variable => \$vars{"diskbin_$sys"}, -text => platform_desc($sys))->pack(-anchor => 'w');
  }
  $f2l->pack(-side => 'left');
  do_net_frame();
  my $f4 = $sw->Frame;
  $f4->pack;
  $f4->Button(-text => $text{'clicknetbin'},
              -command => sub { update_net_archs(); })->pack;
  my $f3 = $sw->Frame;
  $f3->Button(-text => $text{'ok'}, 
     -command => sub { callback_select_systems() ; $sw->destroy })->pack(-side => 'left');
  $f3->Button(-text => $text{'cancel'}, 
     -command => sub { $sw->destroy })->pack(-side => 'right');
  $f3->pack(-expand => 'x');
}


sub menu_set_text {
  my $w = shift;
  my $t = shift;
  $w->configure(-text => $t);
}

sub menu_set_symlink_text {
  menu_set_text($symlinktext, (($vars{'option_symlinks'})?$text{'yes'}:$text{'no'}));
}

sub menu_set_schemebutton_text {
  menu_set_text($schemebutton, "$vars{'selected_scheme'}");
}

sub menu_set_binbutton_text {
  menu_set_text($bintextbutton, "$vars{'n_systems_selected'} $text{'outof'} $vars{'n_systems_available'}");
}

sub menu_set_collections_text {
  menu_set_text($collectionstext, "$vars{'n_collections_selected'} $text{'collof'} $vars{'n_collections_available'}, $text{'diskreq'}: $vars{'total_size'} MB");
}

sub menu_set_pathes_text {
  menu_set_text($texdirtext, "$vars{'TEXDIR'}");
  menu_set_text($texmflocaltext, "$vars{'TEXMFLOCAL'}");
  menu_set_text($texmfsysvartext, "$vars{'TEXMFSYSVAR'}");
}


sub menu_update_texts {
  menu_set_pathes_text;
  menu_set_collections_text;
  menu_set_binbutton_text;
  menu_set_schemebutton_text;
  $optletterstate = ($vars{'option_letter'} ? $text{'yes'} : $text{'no'});
  $optfmtstate = ($vars{'option_fmt'} ? $text{'yes'} : $text{'no'});
  $optsrcstate = ($vars{'option_src'} ? $text{'yes'} : $text{'no'});
  $optdocstate = ($vars{'option_doc'} ? $text{'yes'} : $text{'no'});
  if (unix()) { menu_set_symlink_text; };
}

sub callback_select_scheme {
  my $s = shift;
  select_scheme($s);
  menu_update_texts();
}

sub callback_select_collection {
  calc_depends();
  update_numbers();
  menu_update_texts();
}

sub callback_select_systems() {
  calc_depends();
  update_numbers();
  menu_update_texts();
}

sub callback_edit_directories {
  my ($key,$val) = @_;
  $vars{$key} = $val;
  if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) {
    $vars{'TEXMFLOCAL'}="$1/texmf-local";
    $vars{'TEXMFSYSVAR'}="$1/$texlive_release/texmf-var";
  } elsif ($vars{'TEXDIR'}=~/^(.*)$/) {
    $vars{'TEXMFLOCAL'}="$1/texmf-local";
    $vars{'TEXMFSYSVAR'}="$1/texmf-var";
  }
  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 select_collections {
  my $varref = shift;
  foreach (@_) {
    $varref->{$_} = 1;
  }
}

sub deselect_collections {
  my $varref = shift;
  foreach (@_) {
    $varref->{$_} = 0;
  }
}

sub toggle_and_set_opt_variable {
  my ($varsref, $toggleref) = @_;
  $$toggleref = ($$toggleref eq $text{'yes'}) ? $text{'no'} : $text{'yes'};
  $$varsref = 0;
  $$varsref = 1 if ($$toggleref eq $text{'yes'});
  menu_update_texts();
}

1;

__END__

### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #