diff options
author | Norbert Preining <preining@logic.at> | 2008-01-11 14:24:28 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2008-01-11 14:24:28 +0000 |
commit | 9c54e8bc4d6f2f8de6f27abf3e68b37bc7e7496f (patch) | |
tree | 035285edbacb8963e996b16fbe56ef4d6a2be5f0 /Master | |
parent | 3b241dfaadf61ffa635153d6a029260b82afac17 (diff) |
status bar with updates, select/deselect all buttons, terminal dialog
windows
git-svn-id: svn://tug.org/texlive/trunk@6191 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rwxr-xr-x | Master/install-tl.pl | 49 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 3 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/install-menu-perltk.pl | 80 |
3 files changed, 116 insertions, 16 deletions
diff --git a/Master/install-tl.pl b/Master/install-tl.pl index 7c69aed78ab..07c82d3def0 100755 --- a/Master/install-tl.pl +++ b/Master/install-tl.pl @@ -179,6 +179,13 @@ if ("$opt_url" ne "") { our $tlpdb; my $localtlpdb; +# $finished == 1 if the menu call already did the installation +my $finished = 0; +@::start_install_hook = (); +@::end_install_hook = (); +@::start_postinst_hook = (); +@::start_install_hook = (); + my $system_tmpdir=get_system_tmpdir(); tllog($::LOG_NORMAL, "Platform: ", platform, " => \'", platform_desc(platform), "\'\n"); @@ -216,6 +223,7 @@ if ($opt_profile eq "") { our $MENU_INSTALL = 0; our $MENU_ABORT = 1; our $MENU_QUIT = 2; + our $MENU_ALREADYDONE = 3; if ($opt_gui) { # try to load Tk.pm, but don't die if it doesn't work eval { require Tk; }; @@ -244,23 +252,25 @@ if ($opt_profile eq "") { dump_vars("$system_tmpdir/texlive.vars"); exit(2); } - if ($ret != $MENU_INSTALL) { + if ($ret == $MENU_ALREADYDONE) { + tllog($::LOG_DEBUG, "run_menu has already done the work ... cleaning up!\n"); + $finished = 1; + } + if (!$finished && ($ret != $MENU_INSTALL)) { tllog($::LOG_NORMAL, "Unknown return value of run_menu: $ret\n"); exit(3); } } else { read_profile("$opt_profile"); } -# do the actual installation -calc_depends(); -prepare_installation(); -do_install_packages(); -if (win32()) { - do_win_registry_magic(); + +if (!$finished) { + # do the actual installation + do_installation(); } -do_postinst_stuff(); dump_vars("$system_tmpdir/texlive.vars"); + # if we installed from a profile we don't need to write it out if (-r "$vars{'TEXDIR'}/$InfraLocation/texlive.profile") { tllog($::LOG_NORMAL, "Not overwriting already present profile in $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"); @@ -268,15 +278,12 @@ if (-r "$vars{'TEXDIR'}/$InfraLocation/texlive.profile") { create_profile("$vars{'TEXDIR'}/$InfraLocation/texlive.profile"); tllog($::LOG_DEBUG, "Profile written to $vars{'TEXDIR'}/$InfraLocation/texlive.profile\n"); } - - # Close log file if present close($::LOGFILE) if defined($::LOGFILE); exit(0); - ################################################################### # # FROM HERE ON ONLY SUBROUTINES @@ -284,6 +291,26 @@ exit(0); # ################################################################### +sub do_installation { + # do the actual installation + foreach my $h (@::start_install_hook) { + &$h(); + } + calc_depends(); + prepare_installation(); + do_install_packages(); + if (win32()) { + do_win_registry_magic(); + } + foreach my $h (@::start_postinst_hook) { + &$h(); + } + do_postinst_stuff(); + foreach my $h (@::end_install_hook) { + &$h(); + } +} + sub dump_vars { my $filename=shift; open VARS, ">$filename"; diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 2d748479690..7ec0374d072 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -512,6 +512,9 @@ sub install_packages { my $container_doc_split = $fromtlpdb->config_doc_container; foreach my $package (@$what) { tllog($::LOG_NORMAL, "Installing $package\n"); + foreach my $h (@::install_packages_hook) { + &$h("Installing: $package"); + } my $tlpobj=$fromtlpdb->get_package($package); if (!defined($tlpobj)) { die "STRANGE: $package not to be found in ", $fromtlpdb->root; diff --git a/Master/tlpkg/TeXLive/install-menu-perltk.pl b/Master/tlpkg/TeXLive/install-menu-perltk.pl index db325257ad9..3e26ea4581e 100644 --- a/Master/tlpkg/TeXLive/install-menu-perltk.pl +++ b/Master/tlpkg/TeXLive/install-menu-perltk.pl @@ -22,6 +22,7 @@ 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; @@ -37,6 +38,38 @@ my $texmfsysvartext; my $texdirtext; my $symlinktext; +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"); +} + sub run_menu { calc_depends; $mw = MainWindow->new; @@ -84,13 +117,18 @@ sub run_menu { my $f3 = $mw->Frame; $f3->Button( -text => 'Go!', - -command => sub { $return = $MENU_INSTALL; $mw->destroy }, + -command => sub { do_installation(); + $return = $MENU_ALREADYDONE; + $mw->Dialog(-text => 'Installation finished', -buttons => [qw/Finish/])->Show; + $mw->destroy }, )->pack(-side => 'left'); $f3->Button( -text => 'Cancel', -command => sub { $return = $MENU_ABORT; $mw->destroy } )->pack(-side => 'right'); $f3->pack(-expand => 'x'); + $::statusbar = $mw->Label(-text => 'Status output'); + $::statusbar->pack; menu_update_texts(); Tk::MainLoop(); return($return); @@ -109,10 +147,12 @@ sub menu_edit_vars_value { $sw->Label(-text => "Enter path for $key:")->pack; my $entry = $sw->Entry(-textvariable => $val, -width => 0); $entry->pack; - $sw->Button(-text => "Ok", - -command => sub { $val = $entry->get; callback_edit_directories($key,$val) ; $sw->destroy })->pack; - $sw->Button(-text => "Cancel", - -command => sub { $sw->destroy })->pack; + my $f = $sw->Frame; + $f->Button(-text => "Ok", + -command => sub { $val = $entry->get; callback_edit_directories($key,$val) ; $sw->destroy })->pack(-side => 'left'); + $f->Button(-text => "Cancel", + -command => sub { $sw->destroy })->pack(-side => 'right'); + $f->pack(-expand => 'x'); } sub menu_select_scheme { @@ -158,6 +198,7 @@ sub menu_select_standard_collections { my $sw = $mw->Toplevel; my $fb = $sw->Frame; my $fc = $sw->Frame; + my $fd = $sw->Frame; my $f1 = $fb->Frame; my $f2 = $fb->Frame; $sw->Label(-text => 'Select the collections to be installed')->pack; @@ -174,6 +215,11 @@ sub menu_select_standard_collections { $f1->pack(-side => 'left'); $f2->pack(-side => 'right'); $fb->pack; + $fd->pack(-expand => 'x'); + $fd->Button(-text => "Select all", + -command => sub { select_collections(@collections_std) })->pack(-side => 'left'); + $fd->Button(-text => "Deselect all", + -command => sub { deselect_collections(@collections_std) })->pack(-side => 'right'); $fc->pack(-expand => 'x'); $fc->Button(-text => "Return", -command => sub { callback_select_collection() ; $sw->destroy })->pack(-side => 'left'); @@ -204,6 +250,13 @@ sub menu_select_lang_collections { } $i++; } + my $f1langB = $f1lang->Frame; + $f1langB->pack(-expand => 'x'); + $f1langB->Button(-text => "Select all", + -command => sub { select_collections(@collections_lang) })->pack(-side => 'left'); + $f1langB->Button(-text => "Deselect all", + -command => sub { deselect_collections(@collections_lang) })->pack(-side => 'right'); + my $f1docT = $f1doc->Frame; $f1docT->pack; my $f1docL = $f1doc->Frame; $f1docL->pack; $f1docT->Label(-text => 'Doc/Language Selection')->pack; @@ -219,6 +272,12 @@ sub menu_select_lang_collections { } $i++; } + my $f1docB = $f1doc->Frame; + $f1docB->pack(-expand => 'x'); + $f1docB->Button(-text => "Select all", + -command => sub { select_collections(@collections_lang_doc) })->pack(-side => 'left'); + $f1docB->Button(-text => "Deselect all", + -command => sub { deselect_collections(@collections_lang_doc) })->pack(-side => 'right'); my $f2 = $sw->Frame; $f2->pack(-expand => 'x'); $f2->Button(-text => "Return", -command => sub { callback_select_collection() ; $sw->destroy })->pack(-side => 'left'); @@ -418,6 +477,17 @@ sub dump_vars_stdout { } } +sub select_collections { + foreach (@_) { + $vars{$_} = 1; + } +} + +sub deselect_collections { + foreach (@_) { + $vars{$_} = 0; + } +} 1; |