From 5115ea43525c37d312e493708ce12320cea7aa9b Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 19 Nov 2009 16:21:19 +0000 Subject: start on new gui, change tlmgr so that you can start it with tlmgr gui2 git-svn-id: svn://tug.org/texlive/trunk@16076 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 11 +- Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl | 644 +++++++++++++++++++++ 2 files changed, 654 insertions(+), 1 deletion(-) create mode 100644 Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl (limited to 'Master') diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 8d6d76e9afe..f041cd9152b 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -110,6 +110,8 @@ $::machinereadable = 0; our %opts; +my $new_gui = 0; + main() if $ismain; sub main { @@ -404,6 +406,9 @@ sub execute_action { finish(0); } elsif ($action =~ m/^generate$/i) { action_generate(); + } elsif ($action =~ m/^gui2$/i) { + $new_gui = 1; + action_gui(); } elsif ($action =~ m/^gui$/i) { action_gui(); } elsif ($action =~ m/^arch$/i) { @@ -3043,7 +3048,11 @@ Error message from creating MainWindow: # another GUI instance (or better trying to ...) $opts{"gui"} = 0; - require("tlmgrgui.pl"); + if ($new_gui) { + require("tlmgrgui2.pl"); + } else { + require("tlmgrgui.pl"); + } # should not be reached exit(1); } diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl new file mode 100644 index 00000000000..58a3133c5ae --- /dev/null +++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl @@ -0,0 +1,644 @@ +#!/usr/bin/env perl +# $Id: tlmgrgui2.pl 15823 2009-10-18 01:41:28Z preining $ +# +# Copyright 2009 Norbert Preining +# This file is licensed under the GNU General Public License version 2 +# or any later version. +# +# GUI for tlmgr + +use Tk; +use Tk::Dialog; +use Tk::NoteBook; +use Tk::BrowseEntry; +use Tk::ROText; +use Tk::Balloon; +use Tk::TixGrid; +use TeXLive::Splashscreen; + +use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug); +use TeXLive::TLConfig; + +our $Master; +our $tlmediatlpdb; +our $tlmediasrc; +our $location; +# +our %opts; +# +# the list of packages as shown by TixGrid +# +my %Packages; + +sub update_status_box { + update_status(join(" ", @_)); + $mw->update; +} + +sub init_hooks { + push @::info_hook, \&update_status_box; + push @::warn_hook, \&update_status_box; + push @::debug_hook, \&update_status_box; + push @::ddebug_hook, \&update_status_box; + push @::dddebug_hook, \&update_status_box; +} + +sub update_status { + my ($p) = @_; + $::progressw->insert("end", "$p"); + $::progressw->see("end"); +} + +my $opt_screen = $::guiscreen; + + +# prepare for loading of lang.pl which expects $::lang and $::opt_lang +$::opt_lang = $opts{"gui-lang"} if (defined($opts{"gui-lang"})); + +require("TeXLive/trans.pl"); + +our @update_function_list; + +our $mw = MainWindow->new; +$mw->title("TeX Live Manager $TeXLive::TLConfig::ReleaseYear"); +$mw->withdraw; + +# create a progress bar window +$::progressw = $mw->Scrolled("ROText", -scrollbars => "e", -height => 4); +$::progressw->pack(-expand => 0, -fill => "x", -side => 'bottom'); + + +init_hooks(); + +info(__("Loading local TeX Live Database\nThis may take some time, please wait!") . "\n"); + +our $localtlmedia = TeXLive::TLMedia->new ( $Master ); +die("cannot setup TLMedia in $Master") unless (defined($localtlmedia)); +$localtlpdb = $localtlmedia->tlpdb; +die("cannot find tlpdb!") unless (defined($localtlpdb)); + +our @main_list; + +my $loc = $localtlpdb->option("location"); +if (defined($loc)) { + $location = $loc; +} +if (defined($opts{"location"})) { + $location = $opts{"location"}; +} + +our $balloon = $mw->Balloon(); + + +push @update_function_list, \&check_location_on_ctan; +push @update_function_list, \&init_install_media; + +# +# check that we can actually save the database +# +if (check_on_writable()) { + $::we_can_save = 1; +} else { + $::we_can_save = 0; + # here we should pop up a warning window!!! +} +$::action_button_state = ($::we_can_save ? "normal" : "disabled"); + +our $top = $mw->Frame; + +our $top_top = $top->Frame; +our $top_bot = $top->Frame; +$top_top->pack(-expand => 1, -fill => "x"); +$top_bot->pack(-expand => 1, -fill => "x"); + +our $quit = $top_top->Button(-text => __("Quit"), + -command => sub { $mw->destroy; exit(0); }); + +my $tlmgrrev = give_version(); +chomp($tlmgrrev); +our $about = $top_top->Button(-text => __("About"), + -command => sub { + my $sw = $mw->DialogBox(-title => __("About"), + -buttons => [ __("Ok") ]); + $sw->add("Label", -text => "TeX Live Manager +$tlmgrrev +Copyright 2008 Tomasz Luczak +Copyright 2008, 2009 Norbert Preining + +Licensed under the GNU General Public License version 2 or higher +In case of problems, please contact: texlive\@tug.org" + )->pack(-padx => "3m", -pady => "3m"); + $sw->Show; + }); + +$about->pack(-side => 'right'); +$quit->pack(-side => 'right'); + +$mw->bind('', [ $quit, 'Invoke' ]); + + +$top_top->Label(-text => __("Loaded repository:") . " ")->pack(-side => 'left'); +$top_top->Label(-textvariable => \$location, -relief => "sunken")->pack(-side => 'left'); + +$top_bot->Button(-text => __("Load Default"), -command => sub { run_update_functions(); })->pack(-side => 'left'); + +$top_bot->Button(-text => __("Load other"), -command => sub { menu_edit_location(); })->pack(-side => 'left'); + +# here we add a bit of trickery to make sure that the verbosity level +# as set on the cmd line (-v or -v -v) is kept during pressing the +# debug button on and off. If -v is *not* given activating it afterwards +# defaults to one -v, while if -v -v is given on the cmd line, we keep +# it that way +$balloon->attach( + $top_bot->Checkbutton(-text => __("Debug"), + -onvalue => ($::opt_verbosity == 0 ? 1 : $::opt_verbosity), + -variable => \$::opt_verbosity)->pack(-side => 'right'), + -balloonmsg => __("Turn on debug mode.")); + +# frame .back -borderwidth 2 +our $back = $mw->NoteBook(-borderwidth => 2, -dynamicgeometry => 1); + + +# pack .top .back -side top -fill both -expand 1 +$top->pack(-side => 'top', -fill => 'x', -expand => 0, -padx => '2m', -pady => '2m'); +$back->pack(-side => 'top', -fill => 'both', -expand => 1); + +#require ("do_listframe.pl"); + +######### SHOULD GO INTO A SEPARTE FILE ######################## +# install screen +our $back_f1 = $back->add("packages",-label => __("Package management"), -justify => "left"); + +$screens{"packages"} = $back_f1; + +my $top_frame = $back_f1->Labelframe(-text => "Filters"); +$top_frame->pack(-expand => 1, -fill => "x", -padx => "2m", -pady => "2m"); + +my $filter_frame = $top_frame->Frame(); +$filter_frame->pack; + +my $filter_status = $filter_frame->Labelframe(-text => "Status"); +$filter_status->pack(-side => 'left', -padx => '2m', -pady => '2m'); + +my $status_value = 0; +$filter_status->Radiobutton(-text => "all", + -variable => \$status_value, -value => 0)->pack(-anchor => 'w'); +$filter_status->Radiobutton(-text => "only installed", + -variable => \$status_value, -value => 1)->pack(-anchor => 'w'); +$filter_status->Radiobutton(-text => "only not installed", + -variable => \$status_value, -value => 2)->pack(-anchor => 'w'); +$filter_status->Radiobutton(-text => "only updated", + -variable => \$status_value, -value => 3)->pack(-anchor => 'w'); + +my $filter_category = $filter_frame->Labelframe(-text => "Category"); +$filter_category->pack(-side => 'left', -padx => '2m', -pady => '2m'); +my $show_packages = 1; +my $show_collections = 1; +my $show_schemes = 1; +my $show_tlcore = 1; +$filter_category->Checkbutton(-text => "packages", + -variable => \$show_packages)->pack(-anchor => 'w'); +$filter_category->Checkbutton(-text => "collections", + -variable => \$show_collections)->pack(-anchor => 'w'); +$filter_category->Checkbutton(-text => "schemes", + -variable => \$show_schemes)->pack(-anchor => 'w'); +$filter_category->Checkbutton(-text => "tlcore", + -variable => \$show_tlcore)->pack(-anchor => 'w'); + +my $filter_match = $filter_frame->Labelframe(-text => "Match"); +$filter_match->pack(-side => 'left', -expand => 1, -fill => "y", + -padx => '2m', -pady => '2m'); +my $match_value = 0; +$filter_match->Radiobutton(-text => "all", + -variable => \$match_value, -value => 0)->pack(-anchor => 'w'); +$filter_match->Radiobutton(-text => "matching:", + -variable => \$match_value, -value => 1)->pack(-anchor => 'w'); +$filter_match->Entry(-width => 15)->pack(-anchor => 'w', + -padx => '2m', -fill => 'x', -expand => 1); + +my $filter_button = $filter_frame->Labelframe(-text => "Action"); +$filter_button->pack(-side => 'left', -expand => 1, -fill => "y", + -padx => '2m', -pady => '2m'); +$filter_button->Button(-text => "Apply filters")->pack(-anchor => 'c', + -padx => '2m', -pady => '2m'); +$filter_button->Button(-text => "Reset filters")->pack(-anchor => 'c', + -padx => '2m', -pady => '2m'); + +########## Packages ####################### +my $list_frame = $back_f1->Labelframe(-text => "Packages"); +$list_frame->pack(-expand => 1, -fill => "both", -padx => '2m', -pady => '2m'); +my $g = $list_frame->Scrolled('TixGrid', -scrollbars => "se", -bd => 0, + -floatingrows => 0, -floatingcols => 0, + -leftmargin => 2, # selection and label + -topmargin => 1, # top labels + -selectmode => "none", + -selectunit => "row"); + +$g->pack(qw/-expand yes -fill both -padx 3 -pady 3/); +$g->configure(-formatcmd=>[\&AlternatingLineColoring, $g]); +$g->size(qw/col 4 -size 10char/); +$g->size(qw/col 5 -size 10char/); +$g->size(qw/col default -size auto/); +$g->size(qw/row default -size 1.1char -pad0 3/); + +setup_list(); +update_grid(); + +sub update_grid { + # fill the header + #$g->set(0,0, -itemtype => 'window', -widget => $g->Checkbutton()); + $g->set(1,0, -itemtype => 'text', -text => "Package"); + $g->set(2,0, -itemtype => 'text', -text => "Local Rev"); + $g->set(3,0, -itemtype => 'text', -text => "Remote Rev"); + $g->set(4,0, -itemtype => 'text', -text => "Local Ver"); + $g->set(5,0, -itemtype => 'text', -text => "Remote Ver"); + $g->set(6,0, -itemtype => 'text', -text => "Short Desc"); + + my @schemes; + my @colls; + my @packs; + for my $p (sort keys %Packages) { + if ($p =~ m;^scheme-;) { + push @schemes, $p; + } elsif ($p =~ m;^collection-;) { + push @colls, $p; + } else { + push @packs, $p; + } + } + my $i = 1; + for my $p (@rrr, @colls, @packs) { + if (!$g->infoExists(0,$i)) { + $g->set(0,$i, -itemtype => 'window', -widget => $g->Checkbutton); + } + $g->set(1,$i, -itemtype => 'text', -text => $Packages{$p}{'displayname'}); + $g->set(2,$i, -itemtype => 'text', -text => $Packages{$p}{'localrevision'}) + if defined($Packages{$p}{'localrevision'}); + $g->set(3,$i, -itemtype => 'text', -text => $Packages{$p}{'remoterevision'}) + if defined($Packages{$p}{'remoterevision'}); + $g->set(4,$i, -itemtype => 'text', -text => $Packages{$p}{'localcatalogueversion'}) + if defined($Packages{$p}{'localcatalogueversion'}); + $g->set(5,$i, -itemtype => 'text', -text => $Packages{$p}{'remotecatalogueversion'}) + if defined($Packages{$p}{'remotecatalogueversion'}); + $g->set(6,$i, -itemtype => 'text', -text => $Packages{$p}{'shortdesc'}); + $i++; + } +} + +sub AlternatingLineColoring { + my ($w, $area, @entbox) = @_; + if ($area eq 'main') { + # first format all cells + # no select background -selectbackground => 'lightblue', + $w->formatGrid( @entbox, -selectbackground => 'gray70', + -xon => 1, -xoff => 0, -yon => 1, -yoff => 0, + -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70'); + # format odd lines 1,3,5,7, ... (counting starts at 0!!!) + $w->formatGrid( @entbox, -selectbackground => 'gray90', + -xon => 1, -xoff => 0, -yon => 1, -yoff => 1, + -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90'); + } + if ($area eq 'y_margin') { + my ($ulx, $uly, $lrx, $lry) = @entbox; + # format the checkbuttons backgrounds + for my $i ($uly..$lry) { + $cb = $w->entrycget(0, $i, "-window"); + $cb->configure(-background => (($i-$uly)%2 ? 'gray70' : 'gray90')); + } + # first format all cells + # no select background -selectbackground => 'lightblue', + $w->formatBorder( @entbox, -selectbackground => 'gray70', + -xon => 1, -xoff => 0, -yon => 1, -yoff => 0, + -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70'); + # format odd lines 1,3,5,7, ... (counting starts at 0!!!) + $w->formatBorder( @entbox, -selectbackground => 'gray90', + -xon => 1, -xoff => 0, -yon => 1, -yoff => 1, + -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90'); + } +} + +####### actions frame + +my $bot_frame = $back_f1->Labelframe(-text => "Actions"); +$bot_frame->pack(-expand => 1, -fill => "x", -padx => '2m', -pady => '2m'); + +my $actions_frame = $bot_frame->Frame; +$actions_frame->pack(); + +my $with_sel_frame = $actions_frame->Labelframe(-text => "with selected"); +$with_sel_frame->pack(-padx => "2m", -pady => "2m", -side => "left"); +$with_sel_frame->Button(-text => 'Install')->pack(-side => "left", + -padx => '2m', -pady => '2m', -expand => 0); +$with_sel_frame->Button(-text => 'Upgrade')->pack(-side => "left", + -padx => '2m', -pady => '2m', -expand => 0); +$with_sel_frame->Button(-text => 'Remove')->pack(-side => "left", + -padx => '2m', -pady => '2m', -expand => 0); +$with_sel_frame->Button(-text => 'Backup')->pack(-side => "left", + -padx => '2m', -pady => '2m', -expand => 0); + +my $with_all_frame = $actions_frame->Labelframe(-text => "with all"); +$with_all_frame->pack(-padx => "2m", -pady => "2m", -side => "left"); +$with_all_frame->Button(-text => 'Update all')->pack(-anchor => 'c', -side => "left", + -padx => '2m', -pady => '2m', -expand => 0); + +######################## UNINSTALL ########################### +# uninstall screen +require("gui-uninstall.pl"); +# arch support not be done via tlmgr on win32 +if (!win32()) { + require("gui-arch.pl"); +} +# config screen +require("gui-config.pl"); + +if ($opt_load) { + run_update_functions(); +} + + +if (defined($opt_screen)) { + $back->raise("$opt_screen"); +} + +info(__("Completed") . "\n"); +$mw->deiconify; + + +if (!$::we_can_save) { + my $no_write_warn = $mw->Dialog(-title => "warning", + -text => __("You don't have permissions to change the installation in any way,\nspecifically, the directory %s is not writable.\nPlease run this program as administrator, or contact your local admin.\n\nMost buttons will be disabled.", "$Master/tlpkg/"), + -buttons => [ __("Ok") ])->Show(); +} + +Tk::MainLoop(); + + +sub init_install_media { + my $newroot = $location; + if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) { + # nothing to be done + } else { + $mw->Busy(-recurse => 1); + info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n"); + $tlmediasrc = TeXLive::TLMedia->new($newroot); + info(__("Completed") . "\n"); + $mw->Unbusy; + if (!defined($tlmediasrc)) { + # something went badly wrong, maybe the newroot is wrong? + $mw->Dialog(-title => "warning", + -text => __("Could not load the TeX Live Database from %s\nIf you want to install or update packages, please try with a different package repository!\n\nFor configuration and removal you don\'t have to do anything.", $newroot), + -buttons => [ __("Ok") ])->Show; + $location = __("...please change me..."); + } else { + $tlmediatlpdb = $tlmediasrc->tlpdb; + setup_list(); + update_grid(); + } + } +} + +sub set_text_win { + my ($w, $t) = @_; + $w->delete("0.0", "end"); + $w->insert("0.0", "$t"); + $w->see("0.0"); +} + +sub install_selected_packages { + if (@_) { + my @args = qw/install/; + push @args, @_; + execute_action_gui(@args); + reinit_local_tlpdb(); + # now we check that the installation has succeeded by checking that + # all packages in @_ are installed. Otherwise we pop up a warning window + my $do_warn = 0; + for my $p (@_) { + if (!defined($localtlpdb->get_package($p))) { + $do_warn = 1; + last; + } + } + give_warning_window(__("Installation"), @_) if $do_warn; + } +} + +sub update_selected_packages { + if (@_) { + my @args = qw/update/; + # argument processing + # in case we have critical updates present we do put the list of + # critical updates into the argument instead of --all + if ($critical_updates_present) { + $opts{"self"} = 1; + } else { + if ($_[0] eq "--all") { + $opts{"all"} = 1; + # shift away the --all + shift; + } + } + push @args, @_; + execute_action_gui(@args); + if ($critical_updates_present) { + # terminate here immediately so that we are sure the auto-updater + # is run immediately + # make sure we exit in finish(0) + $::gui_mode = 0; + finish(0); + } + reinit_local_tlpdb(); + } +} + +sub remove_selected_packages { + if (@_) { + my @args = qw/remove/; + push @args, @_; + execute_action_gui(@args); + reinit_local_tlpdb(); + my $do_warn = 0; + for my $p (@_) { + if (defined($localtlpdb->get_package($p))) { + $do_warn = 1; + last; + } + } + give_warning_window(__("Remove"), @_) if $do_warn; + } +} + +sub reinit_local_tlpdb { + $mw->Busy(-recurse => 1); + $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); + die("cannot find tlpdb!") unless (defined($localtlpdb)); + setup_list(); + update_grid(); + $mw->Unbusy; +} + + +# +# creates/updates the list of packages as shown in tix grid +# +sub setup_list { + my @do_later; + my @do_later_media; + for my $p ($localtlpdb->list_packages()) { + # collect packages containing a . for later + # we want to ignore them in most cases but those where there is + # no father package (without .) + if ($p =~ m;\.;) { + push @do_later, $p; + next; + } + my $tlp = $localtlpdb->get_package($p); + # collect information about that package we will show + $Packages{$p}{'displayname'} = $p; + $Packages{$p}{'localrevision'} = $tlp->revision; + $Packages{$p}{'shortdesc'} = $tlp->shortdesc; + if (defined($tlp->cataloguedata->{'version'})) { + $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'}; + } + } + if (defined($tlmediatlpdb)) { + for my $p ($tlmediatlpdb->list_packages()) { + if ($p =~ m;\.;) { + push @do_later_media, $p; + next; + } + my $tlp = $tlmediatlpdb->get_package($p); + $Packages{$p}{'displayname'} = $p; + $Packages{$p}{'remoterevision'} = $tlp->revision; + # overwrite, we assume that the remove version is better ;-) + $Packages{$p}{'shortdesc'} = $tlp->shortdesc; + if (defined($tlp->cataloguedata->{'version'})) { + $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'}; + } + } + } + # + for my $p (@do_later) { + my $s = $p; + $s =~ s!\.[^.]*$!!; + if (!defined($Packages{$s})) { + my $tlp = $localtlpdb->get_package($p); + # collect information about that package we will show + $Packages{$p}{'displayname'} = $p; + $Packages{$p}{'localrevision'} = $tlp->revision; + $Packages{$p}{'shortdesc'} = $tlp->shortdesc; + if (defined($tlp->cataloguedata->{'version'})) { + $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'}; + } + } + } + for my $p (@do_later_media) { + my $s = $p; + $s =~ s!\.[^.]*$!!; + if (!defined($Packages{$s})) { + my $tlp = $tlmediatlpdb->get_package($p); + # collect information about that package we will show + $Packages{$p}{'displayname'} = $p; + $Packages{$p}{'remoterevision'} = $tlp->revision; + $Packages{$p}{'shortdesc'} = $tlp->shortdesc; + if (defined($tlp->cataloguedata->{'version'})) { + $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'}; + } + } + } + # change display names + for my $p (keys %Packages) { + if ($p =~ m/^collection-documentation-(.*)$/) { + $Packages{$p}{'displayname'} = "collection-doc-$1"; + } + } +} + + +sub menu_edit_location { + my $key = shift; + my $val; + my $sw = $mw->Toplevel(-title => __("Change package repository")); + $sw->transient($mw); + $sw->grab(); + $sw->Label(-text => __("New package repository:"))->pack(-padx => "2m", -pady => "2m"); + my $entry = $sw->Entry(-text => $location, -width => 30); + $entry->pack(); + my $f1 = $sw->Frame; + $f1->Button(-text => __("Choose Directory"), + -command => sub { + my $var = $sw->chooseDirectory; + if (defined($var)) { + $entry->delete(0,"end"); + $entry->insert(0,$var); + } + })->pack(-side => "left", -padx => "2m", -pady => "2m"); + $f1->Button(-text => __("Default net package repository"), + -command => sub { + $entry->delete(0,"end"); + $entry->insert(0,$TeXLiveURL); + })->pack(-side => "left", -padx => "2m", -pady => "2m"); + $f1->pack; + my $f = $sw->Frame; + my $okbutton = $f->Button(-text => __("Ok"), + -command => sub { $location = $entry->get; + run_update_functions(); + $sw->destroy; + })->pack(-side => 'left', -padx => "2m", -pady => "2m"); + my $cancelbutton = $f->Button(-text => __("Cancel"), + -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m"); + $f->pack(-expand => 'x'); + $sw->bind('', [ $okbutton, 'Invoke' ]); + $sw->bind('', [ $cancelbutton, 'Invoke' ]); +} + +sub run_update_functions { + foreach my $f (@update_function_list) { + &{$f}(); + } +} + +sub check_location_on_ctan { + # we want to check that if mirror.ctan.org + # is used that we select a mirror once + if ($location =~ m/$TeXLive::TLConfig::TeXLiveServerURL/) { + $location = TeXLive::TLUtils::give_ctan_mirror(); + } +} + +sub execute_action_gui { + # my $td = $mw->Toplevel(-title => __("Status Window")); + # $td->transient($mw); + # $td->grab(); + # my $ok = $td->Button(-text => __("Ok"), -padx => "3m", -pady => "3m", + # -command => sub { $td->destroy; }); + # my $lab = $td->Label(-text => __("Starting") . " @_\n"); + # $lab->pack; + $mw->Busy(-recurse => 1); + execute_action(@_); + info(__("Completed") . "\n"); + $mw->Unbusy; + # my $labb = $td->Label(-text => __("Completed")); + # $labb->pack; + # $ok->pack; +} + +sub give_warning_window { + my ($act, @args) = @_; + my $sw = $mw->DialogBox(-title => __("Warning Window"), -buttons => [ __("Ok") ]); + $sw->add("Label", -text => __("Running %s failed.\nPlease consult the log window for details.", "$act @args") + )->pack(-padx => "3m", -pady => "3m"); + $sw->Show; +} + +1; + +__END__ + + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # -- cgit v1.2.3