summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/installer/tracked-install.pl
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/installer/tracked-install.pl
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/installer/tracked-install.pl')
-rw-r--r--systems/texlive/tlnet/tlpkg/installer/tracked-install.pl139
1 files changed, 139 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/installer/tracked-install.pl b/systems/texlive/tlnet/tlpkg/installer/tracked-install.pl
new file mode 100644
index 0000000000..1f46eed826
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/installer/tracked-install.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+# $Id: tracked-install.pl 48057 2018-06-20 02:14:01Z preining $
+#
+# Copyright 2008-2017 Norbert Preining
+# Copyright 2008 Reinhard Kotucha
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+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", -wrap => "word", -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) {
+ tlwarn ("$t\n");
+ }
+ }
+ if ($::env_warns) {
+ tlwarn($::env_warns);
+ }
+ $::progressw->tagConfigure('centered', -justify => 'center');
+ # basic welcome message
+ foreach my $t (@::welcome_arr) {
+ info("$t\n");
+ }
+ $::progressw->insert("end", "\n");
+
+ do_cleanup();
+
+ # 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));
+ }
+}