updates to the tlmgrgui

git-svn-id: svn://tug.org/texlive/trunk@7845 c570f23f-e606-0410-a88d-b1316a301751

4 files changed, 159 insertions, 15 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgrgui/guinb1.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-install.pl
index 9e2420e0ed8..9e2420e0ed8 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/guinb1.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-install.pl
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/guinb2.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-remove.pl
index 85a8cbcce79..85a8cbcce79 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/guinb2.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-remove.pl
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-uninstall.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-uninstall.pl
new file mode 100644
index 00000000000..5753d589399
--- /dev/null
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-uninstall.pl
@@ -0,0 +1,54 @@
+# gui-uninstall.pl
+# $Id: gui-uninstall.pl 7821 2008-05-03 14:41:01Z preining $
+#
+# Copyright 2009 Tomasz Luczak, Norbert Preining
+#
+# GUI for tlmgr
+#
+
+
+# frame .back.f1
+$back_f3 = $back->Frame;
+
+if ($^O=~/^MSWin(32|64)$/i) {
+  my $lab = $back_f3->Label(-justify    => 'left', 
+           -text => "Start the TeX Live 2008 Uninstaller?");
+
+  $lab->pack(-padx => "10m", -pady => "5m");
+
+  my $f = $back_f3->Frame;
+  $f->pack(-padx => "10m", -pady => "5m");
+  my $ok = $f->Button(-text => "Ok", 
+            -command => sub { 
+                              system("\"$Master/tlpkg/installer/uninst.bat\"");
+                              exit(0); 
+                            });
+  $ok->pack(-side => 'left', -padx => "3m");
+} else {
+  my $lab = $back_f3->Label(-justify    => 'left', 
+           -text => "Really remove the complete TeX Live 2008 installation?");
+
+  $lab->pack(-padx => "10m", -pady => "5m");
+
+  my $f = $back_f3->Frame;
+  $f->pack(-padx => "10m", -pady => "5m");
+
+  my $ok = $f->Button(-text => "Remove TeX Live 2008", 
+          -command => sub { 
+                            system("tlmgr", "uninstall", "--force");
+                            $mw->Dialog(-text => "Complete removal completed", -buttons => [ "Bye" ])->Show;
+                            $mw->destroy; 
+                            exit(0); 
+                          });
+
+  $ok->pack(-side => 'left', -padx => "3m");
+}
+
+1;
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
index 23fabeea21f..fe355347049 100644..100755
--- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
@@ -29,7 +29,7 @@ our $back_f2;
 
 our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
 die("cannot find tlpdb!") unless (defined($localtlpdb));
-our @alllocalpackages = filter_out($localtlpdb->list_packages);
+our @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
 setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform);
 
 our $location = $localtlpdb->option_location;
@@ -53,18 +53,33 @@ our $top = $mw->Frame;
 # }
 
 our $b1 = $top->Button(-text => "Adding packages", 
-              -command => sub { $back_f2->packForget; $back_f1->pack; });
+              -command => sub { 
+                                $back_f2->packForget; 
+                                $back_f3->packForget;
+                                $back_f1->pack;
+                              });
 
 # button .top.b2 -text "Removing packages" -command {
 #     pack forget .back.f1
 #     pack .back.f2
 # }
 our $b2 = $top->Button(-text => "Removing packages",
-               -command => sub { $back_f1->packForget; $back_f2->pack; });
-
+               -command => sub { 
+                                 $back_f1->packForget; 
+                                 $back_f3->packForget;
+                                 $back_f2->pack;
+                               });
+
+our $b3 = $top->Button(-text => "Uninstallation",
+                       -command => sub {
+                                         $back_f1->packForget; 
+                                         $back_f2->packForget; 
+                                         $back_f3->pack; 
+                                       });
 # pack .top.b1 .top.b2 -side left
 $b1->pack(-side => 'left');
 $b2->pack(-side => 'left');
+$b3->pack(-side => 'left');
 
 # frame .back -borderwidth 2
 our $back = $mw->Frame(-borderwidth => 2);
@@ -73,8 +88,9 @@ our $back = $mw->Frame(-borderwidth => 2);
 $top->pack(-side => 'top', -fill => 'both', -expand => 1);
 $back->pack(-side => 'top', -fill => 'both', -expand => 1);
 
-require("guinb1.pl");
-require("guinb2.pl");
+require("gui-install.pl");
+require("gui-remove.pl");
+require("gui-uninstall.pl");
 
 # pack .back.f1
 $back_f1->pack;
@@ -88,7 +104,7 @@ sub init_install_media {
   } else {
     $tlmediasrc = TeXLive::TLMedia->new($newroot);
     $tlmediatlpdb = $tlmediasrc->tlpdb;
-    @allpackages = filter_out($tlmediatlpdb->list_packages);
+    @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
   }
 }
 
@@ -151,34 +167,108 @@ sub update_info_window {
   $iw->insert("0.0", "$shortdesc\n\n$longdesc");
 }
 
+
+sub run_program_show_output {
+  my $td = $mw->Toplevel(-title => "$_[1] process");
+  my ($tf,$ys);
+  my $f1 = $td->Frame;
+  $ys = $f1->Scrollbar(-command => sub { $tf->yview(@_); }, 
+                         -orient => "vertical");
+  $tf = $f1->Text(-width => 50, -wrap => "word", 
+                  -yscrollcommand => sub { $ys->set(@_); });
+  $ys->pack(-side => "right", -fill => "y");
+  $tf->pack(-expand => 1, -fill => "both");
+  $f1->pack;
+  my $f2 = $td->Frame;
+  my $ok = $f2->Button(-text => "OK", -padx => "3m", -pady => "3m",
+                       -command => sub { $td->destroy; });
+  # start the installation, read the output
+  $f2->pack;
+  for (my $i = 0; $i < 100; $i++) {
+    Tk::DoOneEvent(Tk::Event::DONT_WAIT);
+  }
+  #
+  # ok, that stupid perl for windows does not have fork, why? no idea
+  # we have to deal with that
+  if ($^O=~/^MSWin(32|64)$/i) {
+    $tf->insert("end", "Starting @_\n\nThis may take some time!
+Please wait, the output will appear here when ready.\n");
+    for (my $i = 0; $i < 100; $i++) {
+      Tk::DoOneEvent(Tk::Event::DONT_WAIT);
+    }
+    my $ret = `@_`;
+    $tf->insert("end", "$ret\n\nCOMPLETED\n");
+    $tf->see("end");
+    $ok->pack;
+    for (my $i = 0; $i < 100; $i++) {
+      Tk::DoOneEvent(Tk::Event::DONT_WAIT);
+    }
+  } else {
+    my $pid = open(KID_TO_READ, "-|");
+    if ($pid) {   # parent
+      while (<KID_TO_READ>) {
+        $tf->insert("end",$_);
+        $tf->see("end");
+        for (my $i = 0; $i < 100; $i++) {
+          Tk::DoOneEvent(Tk::Event::DONT_WAIT);
+        }
+      }
+      close(KID_TO_READ) || warn "kid exited $?";
+      $tf->insert("end","\n\nCOMPLETED\n");
+      $tf->see("end");
+      $ok->pack;
+    } else { #kid
+      # do not buffer lines ...
+      $| = 1;
+      open STDERR, '>&STDOUT';
+      print "Starting @_\n";
+      exec(@_)
+        || die "can't exec program: $!";
+      # NOTREACHED
+    }
+  }
+}
+
 sub install_selected_packages {
-  system("tlmgr","install", @_);
+  run_program_show_output("tlmgr", "install", @_);
   reinit_local_tlpdb();
 }
 
 sub remove_selected_packages {
-  system("tlmgr", "remove", @_);
+  run_program_show_output("tlmgr", "remove", @_);
   reinit_local_tlpdb();
 }
 
 sub reinit_local_tlpdb {
   $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
   die("cannot find tlpdb!") unless (defined($localtlpdb));
-  @alllocalpackages = filter_out($localtlpdb->list_packages);
-  @allpackages = filter_out($tlmediatlpdb->list_packages);
+  @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
+  @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
 }
 
-sub filter_out {
+sub setup_list {
+  my $addi = shift;
   my @ret;
+  my @other;
   foreach my $p (@_) {
     if ($p !~ m;\.;) {
-      if (defined($localtlpdb->get_package($p))) {
-        push @ret, "(i) $p";
+      my $pushstr = "";
+      if ($addi) {
+        if (defined($localtlpdb->get_package($p))) {
+          $pushstr = "(i) ";
+        } else {
+          $pushstr = "    ";
+        }
+      }
+      $pushstr .= "$p";
+      if ($p =~ m;^collection-;) {
+        push @ret, $pushstr;
       } else {
-        push @ret, "    $p";
+        push @other, $pushstr;
       }
     }
   }
+  push @ret, @other;
   return(@ret);
 }