From c23f71817ef4fd2d6b4e09686d060a156e0ae8b4 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Tue, 3 Jun 2008 07:27:29 +0000 Subject: rename tlmgrgui.pl to tlmgrgui-real.pl git-svn-id: svn://tug.org/texlive/trunk@8509 c570f23f-e606-0410-a88d-b1316a301751 --- .../scripts/texlive/tlmgrgui/tlmgrgui-real.pl | 592 +++++++++++++++++++++ Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl | 592 --------------------- 2 files changed, 592 insertions(+), 592 deletions(-) create mode 100755 Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui-real.pl delete mode 100755 Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl (limited to 'Master/texmf') diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui-real.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui-real.pl new file mode 100755 index 00000000000..ab36a86d13e --- /dev/null +++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui-real.pl @@ -0,0 +1,592 @@ +#!/usr/bin/env perl +# +# $Id$ +# +# Copyright 2008 Tomasz Luczak, Norbert Preining +# +# GUI for tlmgr +# +# TODO: +# - (more complicated) make this script be require-able from tlmgr.pl +# so that we don't have to do the $localtlpdb initialization +# twice, *and* can take advantage of the action_* routines. +# But OTOH then we will not have output into a windows, so I am not +# sure that this would be the best option. +# + +our $Master; + +BEGIN { + $^W = 1; + $Master = `kpsewhich -var-value=SELFAUTOPARENT`; + chomp($Master); + unshift (@INC, "$Master/tlpkg", "$Master/texmf/scripts/texlive/tlmgrgui"); +} + +use TeXLive::TLMedia; +use TeXLive::TLPDB; +use TeXLive::TLConfig; +use TeXLive::TLUtils qw(setup_programs platform_desc win32); +use Getopt::Long qw(:config no_autoabbrev require_order); + + +# +# translation facility, not fully functional by now +# +our %TRANS; +our $LANG; + +$TRANS{'en'} = { + about => "About", + addpkg => "Adding packages", + archs => "Architectures", + cancel => "Cancel", + change => "Change", + changesrc => "Change Location", + changesrclong => "Change the installation source", + changedefaultsrc => "Change default installation source", + newdefaultsrc => "New default installation source", + choosedir => "Choose Directory", + config => "Configuration", + createformats => "Create formats on installation", + currentsource => "Current installation source: ", + debug => "debug", + defaultsource => "Default installation source", + defaultnet => "Default Net Location", + defaultpaperfor => "Default paper for", + defaultpaperall => "Default paper for all", + defaultsettings => "Default settings", + force => "force", + forceballoon => "Force the removal of a package even if it is referenced in a collection.", + nodepballoon => "For collections: install or remove will not install/remove the dependencies", + infoitem => "Info on the selected item", + install => "Installation", + installdoc => "Install macro/font docs", + installsrc => "Install macro/font sources", + installsel => "Install selected", + load => "Load", + warningtxt => "\nAttention.\nPlease check using \"Change\" button if a DVD drive with the TeX Live DVD\nor the correct network address is properly selected,\nthen press \"Load\" button.", + newsource => "New location: ", + next => "Next", + ok => "Ok", + paperfor => "paper select for", + papersettings => "Paper settings", + pressbutton => "Press this button to load the database from the specified location.", + quit => "Quit", + reallyremove => "Really remove the complete TeX Live 2008 installation?\nNo more confirmation will be asked!", + remove => "Remove", + removesel => "Remove selected", + removetl => "Remove TeX Live 2008", + rempkg => "Removing packages", + search => "Search", + remarchnotpos => "Select architectures to be added (removal not possible)", + selpkg => "Select packages", + toggle => "Toggle", + debugballoon => "Turn on debug mode when calling tlmgr.", + removaltab => "Uninstallation", + update => "Update", + updateall => "Update all", + updatesel => "Update selected", + updatepkg => "Updating packages", + ctrlshift => "Use Ctrl or Shift or drag to select more", + withoutdep => "without depends", + yes => "Yes", + starting => "Starting", + maytaketime => "This may take some time!\nPlease wait, the output will appear here when ready.\n", + completed => "Completed", + loaderrortxt => 'Could not load the TeX Live Database from $newroot\nIf you want to install or update packages, please try with a different installation source/location!\n\nFor configuration and removal you don\'t have to do anything.', + changeme => "...please change me...", + nodescription => "(no description available)", + applychanges => "Apply changes", + resetchanges => "Reset changes", + remarchinfo => "Removals of archs currently not supported!", + pleaseuse => "Please use the \"Add/Remove Programs\" from the Control Panel!", + completerem => "Complete removal completed", +}; + + +# +# we keep the translations in different arrays since we MAY add the feature +# to switch language on the fly +sub ___ ($) { + my $s = shift; + # if no $LANG is set just return without anything + return $TRANS{"en"}->{$s} if !defined($LANG); + # if the translation is defined return it + return $TRANS{$LANG}->{"$s"} if defined($TRANS{$LANG}->{"$s"}); + return $TRANS{"en"}->{$s}; +} + +my $opt_location; +my $opt_debug = 0; +my $opt_netarchive; +my $opt_diskarchive; +my $opt_screen; +our $opt_force = 0; +our $opt_nodepends = 0; +my $opt_lang; + +GetOptions("location=s" => \$opt_location, + "netarchive=s" => \$NetArchive, + "diskarchive=s" => \$DiskArchive, + "screen=s" => \$opt_screen, + "force" => \$opt_force, + "lang=s" => \$opt_lang, + "no-depends" => \$opt_nodepends, + "debug!" => \$opt_debug) or die("Unsupported argument!"); + +if (defined($opt_lang)) { + $LANG = $opt_lang; +} else { + if ($^O =~ /^MSWin(32|64)$/i) { + # trying to deduce automatically the country code + my $foo = TeXLive::TLWinGoo::reg_country(); + if ($foo) { + $LANG = $foo; + } else { + debug("Didn't get any usuful code from reg_country: $foo...\n"); + } + } else { + # we load POSIX and locale stuff + require POSIX; + import POSIX qw/locale_h/; + # now we try to deduce $LANG + my $loc = setlocale(&POSIX::LC_MESSAGES); + my ($lang,$area,$codeset); + if ($loc =~ m/^([^_.]*)(_([^.]*))?(\.([^@]*))?(@.*)?$/) { + $lang = defined($1)?$1:""; + } + $LANG = $lang if ($lang); + } +} + + +# +# try loading the lang file +# +if (defined($LANG) && (-r "$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG")) { + open(LANG,"<$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG"); + while () { + chomp; + next if m/^\s*#/; + next if m/^\s*$/; + my ($a,$b) = split(/:/,$_); + $b =~ s/^\s*([^\s])/$1/; + $b =~ s/\s*$//; + next if ($b =~ m/^\s*$/); + if (!utf8::decode($b)) { + warn("decoding string to utf8 didn't work:$b\n"); + } + $b =~ s/\\n/\n/g; + $TRANS{$LANG}{"$a"} = "$b"; + } +} + +# +# ok we try to load Tk and break and give a decent message if it does not +# work: +# +#use Tk; +eval { require Tk; }; +if ($@) { + # that didn't work out, give some usefull error message and stop + if (win32()) { + printf STDERR "Cannot load Tk, that should not happen as we ship it! +How did you start tlmgrgui??\n(Error message: $@)\n"; + } else { + printf STDERR " +Cannot load Tk, thus the GUI cannot be started! +The Perl/Tk module is not shipped with the TeX Live installation. +You have to install it to get tlmgr GUI running. +(Error message: $@) +"; + } + exit 1; +} +use Tk; + +# now require the others ... +#use Tk::Dialog; +#use Tk::NoteBook; +#use Tk::BrowseEntry; +#use Tk::ROText; +#use Tk::Balloon; +require Tk::Dialog; +require Tk::NoteBook; +require Tk::BrowseEntry; +require Tk::ROText; +require Tk::Balloon; + +our @update_function_list; + +our $debugmode = 0; + +our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); +die("cannot find tlpdb!") unless (defined($localtlpdb)); +our @alllocalpackages = setup_list(0,$localtlpdb->list_packages); +our @updatepackages; +setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform); + +our $location; +my $loc = $localtlpdb->option_location; +if (defined($loc)) { + $location = $loc; +} +if (defined($opt_location)) { + $location = $opt_location; +} +# our $location = $localtlpdb->option_location; + +our $tlmediasrc; +our $tlmediatlpdb; +our @allpackages; + +our $mw = MainWindow->new(-title => "tlmgr 2008"); +our $balloon = $mw->Balloon(); + +push @update_function_list, \&init_install_media; +push @update_function_list, \&create_update_list; + +# wm title . "tlmgr 2008" + +# frame .top +our $top = $mw->Frame; + +our $quit = $top->Button(-text => ___"quit", + -command => sub { $mw->destroy; exit(0); }); + +our $about = $top->Button(-text => ___"about", + -command => sub { + $mw->Dialog(-title => ___"about", + -text => "TeX Live Manager GUI +Copyright 2008 Tomasz Luczak, Norbert Preining +License under the GNU General Public License version 2 or higher +In case of problems, please contact: texlive\@tug.org", + -buttons => [ ___"ok" ])->Show; + }); + +$about->pack(-side => 'right'); +$quit->pack(-side => 'right'); + +$top->Label(-text => ___"currentsource" . " ")->pack(-side => 'left'); +$top->Label(-textvariable => \$location, -relief => "sunken")->pack(-side => 'left'); + +$balloon->attach( + $top->Button(-text => ___"load", -command => sub { run_update_functions(); })->pack(-side => 'left'), + -balloonmsg => ___"pressbutton"); + +$balloon->attach( + $top->Button(-text => ___"change", -command => sub { menu_edit_location(); })->pack(-side => 'left'), + -balloonmsg => ___"changesrclong"); + +$balloon->attach( + $top->Checkbutton(-text => ___"debug", + -variable => \$debugmode)->pack(-side => 'left'), + -balloonmsg => ___"debugballoon"); + +# 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); +$back->pack(-side => 'top', -fill => 'both', -expand => 1); + +require ("do_listframe.pl"); +# install screen +our $back_f1 = $back->add("install",-label => ___"install"); +$screens{"install"} = $back_f1; +do_listframe($back_f1, + ___"addpkg", + \@allpackages, + { install => { -text => ___"installsel", + -command => \&install_selected_packages}}, + 0,1 + ); +# update screen +our $back_up = $back->add("update", -label => ___"update"); +$screens{"update"} = $back_up; +do_listframe($back_up, + ___"updatepkg", + \@updatepackages, + { updateall => { -text => ___"updateall", + -command => \&update_selected_packages, + -args => [ "--all" ] + }, + updatesel => { -text => ___"updatesel", + -command => \&update_selected_packages + }}, + 0,0 + ); +# remove screen +our $back_f2 = $back->add("remove", -label => ___"remove"); +$screens{"remove"} = $back_f2; +do_listframe($back_f2, + ___"rempkg", + \@alllocalpackages, + { remove => { -text => ___"removesel", + -command => \&remove_selected_packages}}, + 1,1 + ); +# 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"); + +# run_update_functions(); + +if (defined($opt_screen)) { + $back->raise("$opt_screen"); +} + +Tk::MainLoop(); + + +sub init_install_media { + my $newroot = $location; + if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) { + # nothing to be done + } else { + $tlmediasrc = TeXLive::TLMedia->new($newroot); + if (!defined($tlmediasrc)) { + # something went badly wrong, maybe the newroot is wrong? + $mw->Dialog(-title => "warning", + -text => ___"loaderrortxt", + -buttons => [ ___"ok" ])->Show; + $location = ___"changeme"; + @allpackages = (); + } else { + $tlmediatlpdb = $tlmediasrc->tlpdb; + @allpackages = setup_list(1,$tlmediatlpdb->list_packages); + } + } +} + +sub run_program_show_output { + my $td = $mw->Toplevel(-title => ___"tlmgr process"); + my $tf = $td->Scrolled("ROText", -width => 80, + -height => 10, + -wrap => "none", + -scrollbars => "ose" + )->pack(-expand => 1, -fill => "both"); + my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m", + -command => sub { $td->destroy; }); + # start the installation, read the output + for (my $i = 0; $i < 100; $i++) { + Tk::DoOneEvent(Tk::Event::DONT_WAIT); + } + # + # ok, that stupid perl for windows does not have fork, why? no idea + # we have to deal with that + if ($^O=~/^MSWin(32|64)$/i) { + $tf->insert("end", ___("starting") . " @_\n\n" . ___"maytaketime"); + for (my $i = 0; $i < 100; $i++) { + Tk::DoOneEvent(Tk::Event::DONT_WAIT); + } + my $ret = `@_`; + $tf->insert("end", "$ret\n\n" . ___("completed") . "\n"); + $tf->see("end"); + $ok->pack; + for (my $i = 0; $i < 100; $i++) { + Tk::DoOneEvent(Tk::Event::DONT_WAIT); + } + } else { + my $pid = open(KID_TO_READ, "-|"); + if ($pid) { # parent + while () { + $tf->insert("end",$_); + $tf->see("end"); + for (my $i = 0; $i < 100; $i++) { + Tk::DoOneEvent(Tk::Event::DONT_WAIT); + } + } + close(KID_TO_READ) || warn "kid exited $?"; + $tf->insert("end","\n\nCOMPLETED\n"); + $tf->see("end"); + $ok->pack; + } else { #kid + # do not buffer lines ... + $| = 1; + open STDERR, '>&STDOUT'; + print ___("starting") . " @_\n"; + exec(@_) + || die "can't exec program: $!"; + # NOTREACHED + } + } +} + +sub install_selected_packages { + if (@_) { + my @execlist; + push @execlist, "tlmgr", "--location", "$location"; + if ($debugmode) { + push @execlist, "-v"; + } + push @execlist, "install"; + if ($opt_nodepends) { + push @execlist, "--no-depends"; + } + push @execlist, @_; + run_program_show_output(@execlist); + reinit_local_tlpdb(); + } +} + +sub update_selected_packages { + if (@_) { + my @execlist; + push @execlist, "tlmgr", "--location", "$location"; + if ($debugmode) { + push @execlist, "-v"; + } + push @execlist, "update", @_; + run_program_show_output(@execlist); + reinit_local_tlpdb(); + } +} + +sub remove_selected_packages { + if (@_) { + my @execlist; + if ($debugmode) { + push @execlist, "tlmgr", "-v", "remove"; + } else { + push @execlist, "tlmgr", "remove"; + } + if ($opt_nodepends) { + push @execlist, "--no-depends"; + } + if ($opt_force) { + push @execlist, "--force"; + } + push @execlist, @_; + run_program_show_output(@execlist); + reinit_local_tlpdb(); + } +} + +sub reinit_local_tlpdb { + $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); + die("cannot find tlpdb!") unless (defined($localtlpdb)); + @alllocalpackages = setup_list(0,$localtlpdb->list_packages); + if (defined($tlmediatlpdb)) { + @allpackages = setup_list(1,$tlmediatlpdb->list_packages); + } + create_update_list(); +} + +sub create_update_list { + my @ret = (); + my @archret = (); + if (defined($tlmediatlpdb)) { + foreach my $lp ($localtlpdb->list_packages) { + next if ($lp =~ m/00texlive-installation.config/); + my $lrev = $localtlpdb->get_package($lp)->revision; + my $up = $tlmediatlpdb->get_package($lp); + my $urev; + if ($up) { + $urev = $up->revision; + } else { + $urev = 0; + } + if ($urev > $lrev) { + if ($lp =~ m/\./) { + push @archret, $lp; + } else { + push @ret, $lp; + } + } + } + foreach my $p (@archret) { + my $foundparent = 0; + foreach my $q (@ret) { + $foundparent = 1 if ($p =~ m/^$q\./); + } + push @ret, $p unless $foundparent; + } + } else { + @ret = (); + } + @updatepackages = @ret; +} + +sub setup_list { + my $addi = shift; + my @ret; + my @other; + foreach my $p (@_) { + if ($p !~ m;\.;) { + my $pushstr = ""; + if ($addi) { + if (defined($localtlpdb->get_package($p))) { + $pushstr = "(i) "; + } else { + $pushstr = " "; + } + } + $pushstr .= "$p"; + if ($p =~ m;^collection-;) { + push @ret, $pushstr; + } else { + push @other, $pushstr; + } + } + } + push @ret, @other; + return(@ret); +} + + +sub menu_edit_location { + my $key = shift; + my $val; + my $sw = $mw->Toplevel(-title => ___"changesrc"); + my $f1 = $sw->Frame; + $f1->Label(-text => ___"newsource")->pack(-side => "left"); + my $entry = $f1->Entry(-text => $location, -width => 30); + $entry->pack(-side => "left"); + $f1->Button(-text => ___"choosedir", + -command => sub { + my $var = $sw->chooseDirectory; + if (defined($var)) { + $entry->delete(0,"end"); + $entry->insert(0,$var); + } + })->pack(-side => "left"); + $f1->Button(-text => ___"defaultnet", + -command => sub { + $entry->delete(0,"end"); + $entry->insert(0,$TeXLiveURL); + })->pack(-side => "left"); + $f1->pack; + my $f = $sw->Frame; + $f->Button(-text => 'Ok', + -command => sub { $location = $entry->get; + run_update_functions() ; + $sw->destroy })->pack(-side => 'left'); + $f->Button(-text => 'Cancel', + -command => sub { $sw->destroy })->pack(-side => 'right'); + $f->pack(-expand => 'x'); +} + +sub run_update_functions { + foreach my $f (@update_function_list) { + &{$f}(); + } +} + + +__END__ + + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl deleted file mode 100755 index ab36a86d13e..00000000000 --- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl +++ /dev/null @@ -1,592 +0,0 @@ -#!/usr/bin/env perl -# -# $Id$ -# -# Copyright 2008 Tomasz Luczak, Norbert Preining -# -# GUI for tlmgr -# -# TODO: -# - (more complicated) make this script be require-able from tlmgr.pl -# so that we don't have to do the $localtlpdb initialization -# twice, *and* can take advantage of the action_* routines. -# But OTOH then we will not have output into a windows, so I am not -# sure that this would be the best option. -# - -our $Master; - -BEGIN { - $^W = 1; - $Master = `kpsewhich -var-value=SELFAUTOPARENT`; - chomp($Master); - unshift (@INC, "$Master/tlpkg", "$Master/texmf/scripts/texlive/tlmgrgui"); -} - -use TeXLive::TLMedia; -use TeXLive::TLPDB; -use TeXLive::TLConfig; -use TeXLive::TLUtils qw(setup_programs platform_desc win32); -use Getopt::Long qw(:config no_autoabbrev require_order); - - -# -# translation facility, not fully functional by now -# -our %TRANS; -our $LANG; - -$TRANS{'en'} = { - about => "About", - addpkg => "Adding packages", - archs => "Architectures", - cancel => "Cancel", - change => "Change", - changesrc => "Change Location", - changesrclong => "Change the installation source", - changedefaultsrc => "Change default installation source", - newdefaultsrc => "New default installation source", - choosedir => "Choose Directory", - config => "Configuration", - createformats => "Create formats on installation", - currentsource => "Current installation source: ", - debug => "debug", - defaultsource => "Default installation source", - defaultnet => "Default Net Location", - defaultpaperfor => "Default paper for", - defaultpaperall => "Default paper for all", - defaultsettings => "Default settings", - force => "force", - forceballoon => "Force the removal of a package even if it is referenced in a collection.", - nodepballoon => "For collections: install or remove will not install/remove the dependencies", - infoitem => "Info on the selected item", - install => "Installation", - installdoc => "Install macro/font docs", - installsrc => "Install macro/font sources", - installsel => "Install selected", - load => "Load", - warningtxt => "\nAttention.\nPlease check using \"Change\" button if a DVD drive with the TeX Live DVD\nor the correct network address is properly selected,\nthen press \"Load\" button.", - newsource => "New location: ", - next => "Next", - ok => "Ok", - paperfor => "paper select for", - papersettings => "Paper settings", - pressbutton => "Press this button to load the database from the specified location.", - quit => "Quit", - reallyremove => "Really remove the complete TeX Live 2008 installation?\nNo more confirmation will be asked!", - remove => "Remove", - removesel => "Remove selected", - removetl => "Remove TeX Live 2008", - rempkg => "Removing packages", - search => "Search", - remarchnotpos => "Select architectures to be added (removal not possible)", - selpkg => "Select packages", - toggle => "Toggle", - debugballoon => "Turn on debug mode when calling tlmgr.", - removaltab => "Uninstallation", - update => "Update", - updateall => "Update all", - updatesel => "Update selected", - updatepkg => "Updating packages", - ctrlshift => "Use Ctrl or Shift or drag to select more", - withoutdep => "without depends", - yes => "Yes", - starting => "Starting", - maytaketime => "This may take some time!\nPlease wait, the output will appear here when ready.\n", - completed => "Completed", - loaderrortxt => 'Could not load the TeX Live Database from $newroot\nIf you want to install or update packages, please try with a different installation source/location!\n\nFor configuration and removal you don\'t have to do anything.', - changeme => "...please change me...", - nodescription => "(no description available)", - applychanges => "Apply changes", - resetchanges => "Reset changes", - remarchinfo => "Removals of archs currently not supported!", - pleaseuse => "Please use the \"Add/Remove Programs\" from the Control Panel!", - completerem => "Complete removal completed", -}; - - -# -# we keep the translations in different arrays since we MAY add the feature -# to switch language on the fly -sub ___ ($) { - my $s = shift; - # if no $LANG is set just return without anything - return $TRANS{"en"}->{$s} if !defined($LANG); - # if the translation is defined return it - return $TRANS{$LANG}->{"$s"} if defined($TRANS{$LANG}->{"$s"}); - return $TRANS{"en"}->{$s}; -} - -my $opt_location; -my $opt_debug = 0; -my $opt_netarchive; -my $opt_diskarchive; -my $opt_screen; -our $opt_force = 0; -our $opt_nodepends = 0; -my $opt_lang; - -GetOptions("location=s" => \$opt_location, - "netarchive=s" => \$NetArchive, - "diskarchive=s" => \$DiskArchive, - "screen=s" => \$opt_screen, - "force" => \$opt_force, - "lang=s" => \$opt_lang, - "no-depends" => \$opt_nodepends, - "debug!" => \$opt_debug) or die("Unsupported argument!"); - -if (defined($opt_lang)) { - $LANG = $opt_lang; -} else { - if ($^O =~ /^MSWin(32|64)$/i) { - # trying to deduce automatically the country code - my $foo = TeXLive::TLWinGoo::reg_country(); - if ($foo) { - $LANG = $foo; - } else { - debug("Didn't get any usuful code from reg_country: $foo...\n"); - } - } else { - # we load POSIX and locale stuff - require POSIX; - import POSIX qw/locale_h/; - # now we try to deduce $LANG - my $loc = setlocale(&POSIX::LC_MESSAGES); - my ($lang,$area,$codeset); - if ($loc =~ m/^([^_.]*)(_([^.]*))?(\.([^@]*))?(@.*)?$/) { - $lang = defined($1)?$1:""; - } - $LANG = $lang if ($lang); - } -} - - -# -# try loading the lang file -# -if (defined($LANG) && (-r "$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG")) { - open(LANG,"<$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG"); - while () { - chomp; - next if m/^\s*#/; - next if m/^\s*$/; - my ($a,$b) = split(/:/,$_); - $b =~ s/^\s*([^\s])/$1/; - $b =~ s/\s*$//; - next if ($b =~ m/^\s*$/); - if (!utf8::decode($b)) { - warn("decoding string to utf8 didn't work:$b\n"); - } - $b =~ s/\\n/\n/g; - $TRANS{$LANG}{"$a"} = "$b"; - } -} - -# -# ok we try to load Tk and break and give a decent message if it does not -# work: -# -#use Tk; -eval { require Tk; }; -if ($@) { - # that didn't work out, give some usefull error message and stop - if (win32()) { - printf STDERR "Cannot load Tk, that should not happen as we ship it! -How did you start tlmgrgui??\n(Error message: $@)\n"; - } else { - printf STDERR " -Cannot load Tk, thus the GUI cannot be started! -The Perl/Tk module is not shipped with the TeX Live installation. -You have to install it to get tlmgr GUI running. -(Error message: $@) -"; - } - exit 1; -} -use Tk; - -# now require the others ... -#use Tk::Dialog; -#use Tk::NoteBook; -#use Tk::BrowseEntry; -#use Tk::ROText; -#use Tk::Balloon; -require Tk::Dialog; -require Tk::NoteBook; -require Tk::BrowseEntry; -require Tk::ROText; -require Tk::Balloon; - -our @update_function_list; - -our $debugmode = 0; - -our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); -die("cannot find tlpdb!") unless (defined($localtlpdb)); -our @alllocalpackages = setup_list(0,$localtlpdb->list_packages); -our @updatepackages; -setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform); - -our $location; -my $loc = $localtlpdb->option_location; -if (defined($loc)) { - $location = $loc; -} -if (defined($opt_location)) { - $location = $opt_location; -} -# our $location = $localtlpdb->option_location; - -our $tlmediasrc; -our $tlmediatlpdb; -our @allpackages; - -our $mw = MainWindow->new(-title => "tlmgr 2008"); -our $balloon = $mw->Balloon(); - -push @update_function_list, \&init_install_media; -push @update_function_list, \&create_update_list; - -# wm title . "tlmgr 2008" - -# frame .top -our $top = $mw->Frame; - -our $quit = $top->Button(-text => ___"quit", - -command => sub { $mw->destroy; exit(0); }); - -our $about = $top->Button(-text => ___"about", - -command => sub { - $mw->Dialog(-title => ___"about", - -text => "TeX Live Manager GUI -Copyright 2008 Tomasz Luczak, Norbert Preining -License under the GNU General Public License version 2 or higher -In case of problems, please contact: texlive\@tug.org", - -buttons => [ ___"ok" ])->Show; - }); - -$about->pack(-side => 'right'); -$quit->pack(-side => 'right'); - -$top->Label(-text => ___"currentsource" . " ")->pack(-side => 'left'); -$top->Label(-textvariable => \$location, -relief => "sunken")->pack(-side => 'left'); - -$balloon->attach( - $top->Button(-text => ___"load", -command => sub { run_update_functions(); })->pack(-side => 'left'), - -balloonmsg => ___"pressbutton"); - -$balloon->attach( - $top->Button(-text => ___"change", -command => sub { menu_edit_location(); })->pack(-side => 'left'), - -balloonmsg => ___"changesrclong"); - -$balloon->attach( - $top->Checkbutton(-text => ___"debug", - -variable => \$debugmode)->pack(-side => 'left'), - -balloonmsg => ___"debugballoon"); - -# 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); -$back->pack(-side => 'top', -fill => 'both', -expand => 1); - -require ("do_listframe.pl"); -# install screen -our $back_f1 = $back->add("install",-label => ___"install"); -$screens{"install"} = $back_f1; -do_listframe($back_f1, - ___"addpkg", - \@allpackages, - { install => { -text => ___"installsel", - -command => \&install_selected_packages}}, - 0,1 - ); -# update screen -our $back_up = $back->add("update", -label => ___"update"); -$screens{"update"} = $back_up; -do_listframe($back_up, - ___"updatepkg", - \@updatepackages, - { updateall => { -text => ___"updateall", - -command => \&update_selected_packages, - -args => [ "--all" ] - }, - updatesel => { -text => ___"updatesel", - -command => \&update_selected_packages - }}, - 0,0 - ); -# remove screen -our $back_f2 = $back->add("remove", -label => ___"remove"); -$screens{"remove"} = $back_f2; -do_listframe($back_f2, - ___"rempkg", - \@alllocalpackages, - { remove => { -text => ___"removesel", - -command => \&remove_selected_packages}}, - 1,1 - ); -# 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"); - -# run_update_functions(); - -if (defined($opt_screen)) { - $back->raise("$opt_screen"); -} - -Tk::MainLoop(); - - -sub init_install_media { - my $newroot = $location; - if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) { - # nothing to be done - } else { - $tlmediasrc = TeXLive::TLMedia->new($newroot); - if (!defined($tlmediasrc)) { - # something went badly wrong, maybe the newroot is wrong? - $mw->Dialog(-title => "warning", - -text => ___"loaderrortxt", - -buttons => [ ___"ok" ])->Show; - $location = ___"changeme"; - @allpackages = (); - } else { - $tlmediatlpdb = $tlmediasrc->tlpdb; - @allpackages = setup_list(1,$tlmediatlpdb->list_packages); - } - } -} - -sub run_program_show_output { - my $td = $mw->Toplevel(-title => ___"tlmgr process"); - my $tf = $td->Scrolled("ROText", -width => 80, - -height => 10, - -wrap => "none", - -scrollbars => "ose" - )->pack(-expand => 1, -fill => "both"); - my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m", - -command => sub { $td->destroy; }); - # start the installation, read the output - for (my $i = 0; $i < 100; $i++) { - Tk::DoOneEvent(Tk::Event::DONT_WAIT); - } - # - # ok, that stupid perl for windows does not have fork, why? no idea - # we have to deal with that - if ($^O=~/^MSWin(32|64)$/i) { - $tf->insert("end", ___("starting") . " @_\n\n" . ___"maytaketime"); - for (my $i = 0; $i < 100; $i++) { - Tk::DoOneEvent(Tk::Event::DONT_WAIT); - } - my $ret = `@_`; - $tf->insert("end", "$ret\n\n" . ___("completed") . "\n"); - $tf->see("end"); - $ok->pack; - for (my $i = 0; $i < 100; $i++) { - Tk::DoOneEvent(Tk::Event::DONT_WAIT); - } - } else { - my $pid = open(KID_TO_READ, "-|"); - if ($pid) { # parent - while () { - $tf->insert("end",$_); - $tf->see("end"); - for (my $i = 0; $i < 100; $i++) { - Tk::DoOneEvent(Tk::Event::DONT_WAIT); - } - } - close(KID_TO_READ) || warn "kid exited $?"; - $tf->insert("end","\n\nCOMPLETED\n"); - $tf->see("end"); - $ok->pack; - } else { #kid - # do not buffer lines ... - $| = 1; - open STDERR, '>&STDOUT'; - print ___("starting") . " @_\n"; - exec(@_) - || die "can't exec program: $!"; - # NOTREACHED - } - } -} - -sub install_selected_packages { - if (@_) { - my @execlist; - push @execlist, "tlmgr", "--location", "$location"; - if ($debugmode) { - push @execlist, "-v"; - } - push @execlist, "install"; - if ($opt_nodepends) { - push @execlist, "--no-depends"; - } - push @execlist, @_; - run_program_show_output(@execlist); - reinit_local_tlpdb(); - } -} - -sub update_selected_packages { - if (@_) { - my @execlist; - push @execlist, "tlmgr", "--location", "$location"; - if ($debugmode) { - push @execlist, "-v"; - } - push @execlist, "update", @_; - run_program_show_output(@execlist); - reinit_local_tlpdb(); - } -} - -sub remove_selected_packages { - if (@_) { - my @execlist; - if ($debugmode) { - push @execlist, "tlmgr", "-v", "remove"; - } else { - push @execlist, "tlmgr", "remove"; - } - if ($opt_nodepends) { - push @execlist, "--no-depends"; - } - if ($opt_force) { - push @execlist, "--force"; - } - push @execlist, @_; - run_program_show_output(@execlist); - reinit_local_tlpdb(); - } -} - -sub reinit_local_tlpdb { - $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); - die("cannot find tlpdb!") unless (defined($localtlpdb)); - @alllocalpackages = setup_list(0,$localtlpdb->list_packages); - if (defined($tlmediatlpdb)) { - @allpackages = setup_list(1,$tlmediatlpdb->list_packages); - } - create_update_list(); -} - -sub create_update_list { - my @ret = (); - my @archret = (); - if (defined($tlmediatlpdb)) { - foreach my $lp ($localtlpdb->list_packages) { - next if ($lp =~ m/00texlive-installation.config/); - my $lrev = $localtlpdb->get_package($lp)->revision; - my $up = $tlmediatlpdb->get_package($lp); - my $urev; - if ($up) { - $urev = $up->revision; - } else { - $urev = 0; - } - if ($urev > $lrev) { - if ($lp =~ m/\./) { - push @archret, $lp; - } else { - push @ret, $lp; - } - } - } - foreach my $p (@archret) { - my $foundparent = 0; - foreach my $q (@ret) { - $foundparent = 1 if ($p =~ m/^$q\./); - } - push @ret, $p unless $foundparent; - } - } else { - @ret = (); - } - @updatepackages = @ret; -} - -sub setup_list { - my $addi = shift; - my @ret; - my @other; - foreach my $p (@_) { - if ($p !~ m;\.;) { - my $pushstr = ""; - if ($addi) { - if (defined($localtlpdb->get_package($p))) { - $pushstr = "(i) "; - } else { - $pushstr = " "; - } - } - $pushstr .= "$p"; - if ($p =~ m;^collection-;) { - push @ret, $pushstr; - } else { - push @other, $pushstr; - } - } - } - push @ret, @other; - return(@ret); -} - - -sub menu_edit_location { - my $key = shift; - my $val; - my $sw = $mw->Toplevel(-title => ___"changesrc"); - my $f1 = $sw->Frame; - $f1->Label(-text => ___"newsource")->pack(-side => "left"); - my $entry = $f1->Entry(-text => $location, -width => 30); - $entry->pack(-side => "left"); - $f1->Button(-text => ___"choosedir", - -command => sub { - my $var = $sw->chooseDirectory; - if (defined($var)) { - $entry->delete(0,"end"); - $entry->insert(0,$var); - } - })->pack(-side => "left"); - $f1->Button(-text => ___"defaultnet", - -command => sub { - $entry->delete(0,"end"); - $entry->insert(0,$TeXLiveURL); - })->pack(-side => "left"); - $f1->pack; - my $f = $sw->Frame; - $f->Button(-text => 'Ok', - -command => sub { $location = $entry->get; - run_update_functions() ; - $sw->destroy })->pack(-side => 'left'); - $f->Button(-text => 'Cancel', - -command => sub { $sw->destroy })->pack(-side => 'right'); - $f->pack(-expand => 'x'); -} - -sub run_update_functions { - foreach my $f (@update_function_list) { - &{$f}(); - } -} - - -__END__ - - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # -- cgit v1.2.3