1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
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));
}
}
|
