diff options
author | Norbert Preining <preining@logic.at> | 2009-11-20 02:02:11 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2009-11-20 02:02:11 +0000 |
commit | a627c2b9d0d0331b673ddfd003f21736a16c6f60 (patch) | |
tree | 4613ab10f2b19977d86a05a9fdd9a7f77587adbd | |
parent | f2805c8077446354e0cf7018adefd73b90847437 (diff) |
do not include that one for now
git-svn-id: svn://tug.org/texlive/trunk@16087 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r-- | Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl | 644 |
1 files changed, 0 insertions, 644 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl deleted file mode 100644 index 58a3133c5ae..00000000000 --- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl +++ /dev/null @@ -1,644 +0,0 @@ -#!/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('<Escape>', [ $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('<Return>', [ $okbutton, 'Invoke' ]); - $sw->bind('<Escape>', [ $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: # |