summaryrefslogtreecommitdiff
path: root/Master/tlpkg/installer/tracked-install.pl
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2017-04-15 08:22:51 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2017-04-15 08:22:51 +0000
commit2b467244921da9f75590f1ca21e3f6d1eae09471 (patch)
tree5551f25d5aaf35942ba0da8be9cd32d32cabf88c /Master/tlpkg/installer/tracked-install.pl
parentade96bccf43fcbd9bdf05e4943942bf59dc3c488 (diff)
Reworked installer and tlaunch option
git-svn-id: svn://tug.org/texlive/trunk@43805 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/installer/tracked-install.pl')
-rw-r--r--Master/tlpkg/installer/tracked-install.pl141
1 files changed, 141 insertions, 0 deletions
diff --git a/Master/tlpkg/installer/tracked-install.pl b/Master/tlpkg/installer/tracked-install.pl
new file mode 100644
index 00000000000..bdc12e3f041
--- /dev/null
+++ b/Master/tlpkg/installer/tracked-install.pl
@@ -0,0 +1,141 @@
+#!/usr/bin/env perl
+# $Id: install-menu-perltk.pl 41176 2016-05-16 00:42:28Z preining $
+#
+# Copyright 2008-2014 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: 41176 $';
+$svnrev =~ m/: ([0-9]+) /;
+$::menurevision = $1;
+
+require Tk;
+require Tk::ROText;
+require Tk::ProgressBar;
+
+use utf8;
+no utf8;
+
+sub installer_tracker {
+ my $ret;
+ # create a progress bar window
+ $::sww = Tk::MainWindow->new;
+ $::sww->Label(-text => __("Installation process"))->pack;
+ #warn "Debug!! Creating text window";
+ $::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 18);
+ #warn "Debug!! Created text window";
+ $::progressw->pack(-expand => 1, -fill => "both");
+ #warn "Debug!! Placed text window";
+ 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 = $::sww->Button(
+ -text => __("Cancel"),
+ -command => sub {
+ do_cleanup(); $::sww->destroy;
+ # POSIX::exit prevents Tk error message 'Tk::Error: ("after" script)'
+ POSIX::exit(1);
+ })->pack(-pady => "2m");
+ $b->focus();
+ # $f->pack;
+ setup_hooks_perltk();
+
+ $ret = do_installation();
+
+ if (@::WARNLINES) {
+ foreach my $t (@::WARNLINES) {
+ update_status ($t);
+ }
+ }
+ if ($::env_warns) {
+ update_status($::env_warns);
+ }
+ $::progressw->tagConfigure('centered', -justify => 'center');
+ # basic welcome message
+ foreach my $t (@::welcome_arr) {
+ my $s = shift @$t;
+ $::progressw->insert("end", __($s, @$t)."\n", 'centered');
+ }
+ $::progressw->insert("end", "\n");
+ # additional info
+ if ($::LOGFILENAME) {
+ $::progressw->insert ("end", "Logfile: $::LOGFILENAME");
+ } else {
+ # do_cleanup sets $::LOGFILENAME to ""
+ #if no logfile could be written
+ $::progressw->insert ("end",
+ "Cannot create logfile $::vars{'TEXDIR'}/install-tl.log: $!");
+ }
+ if (@::WARNLINES or $::env_vars or !$::LOGFILENAME) {
+ $::progressw->insert("end", "\n");
+ $::progressw->insert("end", __("Scroll back to inspect warnings"));
+ }
+ $::progressw->insert("end", "\n");
+ my $linechar = $::progressw->index("end");
+ $::progressw->see("end");
+ $::progressw->tagAdd("centered", $linechar, "end");
+ $::progressw->tagConfigure("centered", -justify => "center");
+ $b->configure(
+ -text => __("Finish"),
+ -command => sub {
+ $::sww->destroy; return $ret;
+ });
+
+ Tk::MainLoop();
+ return $ret;
+} # installer_tracker
+
+#sub tracked_installation {
+# # undo binding, since this should run only once
+# my $b = shift;
+# $b->bind('<Map>' => '');
+# $ret = do_installation();
+# $::sww->destroy;
+#}
+
+sub setup_hooks_perltk {
+ @::info_hook = ();
+ push @::info_hook,
+ sub {
+ update_status(join(" ",@_));
+ $::sww->update;
+ };
+ push @::warn_hook,
+ sub {
+ return unless defined $::sww ;
+ update_status(join(" ",@_));
+ };
+ @::install_packages_hook = ();
+ push @::install_packages_hook, \&update_progressbar;
+ push @::install_packages_hook,
+ sub {
+ return unless defined $::sww;
+ $::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));
+ }
+}