diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2021-02-27 14:17:34 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2021-02-27 14:17:34 +0000 |
commit | a9ab728d2a8b514da67b964a845f2e5bb7308f60 (patch) | |
tree | b3bb1c4353420103f6e4fd253d67bd64aa07fc96 /Master/tlpkg | |
parent | 031c04eef86cf6a023875460fb579c853f7cb81b (diff) |
Translations loaded in tlmgr and install-tl
git-svn-id: svn://tug.org/texlive/trunk@57970 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg')
-rw-r--r-- | Master/tlpkg/TeXLive/trans.pl | 6 | ||||
-rwxr-xr-x | Master/tlpkg/bin/tl-update-messages | 4 | ||||
-rw-r--r-- | Master/tlpkg/installer/DirSelect.pm | 503 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-extl.pl | 13 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-perltk.pl | 1291 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-text.pl | 17 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-wizard.pl | 622 | ||||
-rwxr-xr-x | Master/tlpkg/installer/install-tl-gui.tcl | 48 | ||||
-rwxr-xr-x | Master/tlpkg/installer/texdirsel.pl | 277 | ||||
-rw-r--r-- | Master/tlpkg/installer/tracked-install.pl | 139 |
10 files changed, 14 insertions, 2906 deletions
diff --git a/Master/tlpkg/TeXLive/trans.pl b/Master/tlpkg/TeXLive/trans.pl index 951c4f83ca0..b21096283e4 100644 --- a/Master/tlpkg/TeXLive/trans.pl +++ b/Master/tlpkg/TeXLive/trans.pl @@ -96,11 +96,11 @@ sub __ ($@) { } # $ret is already set initially } + $ret =~ s/\\n/\n/g; + $ret =~ s/\\"/"/g; + $ret =~ s/\\\\/\\/g; } # translate back $ret: - $ret =~ s/\\n/\n/g; - $ret =~ s/\\"/"/g; - $ret =~ s/\\\\/\\/g; return sprintf($ret, @_); } diff --git a/Master/tlpkg/bin/tl-update-messages b/Master/tlpkg/bin/tl-update-messages index 5994e68c66b..13fc86c0665 100755 --- a/Master/tlpkg/bin/tl-update-messages +++ b/Master/tlpkg/bin/tl-update-messages @@ -26,10 +26,8 @@ xgettext -o tlpkg/translations/messages.pot \ --package-version=2021 \ --package-name="TeX Live" \ -k__ -k\$__ -k%__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -kN__ -k \ - tlpkg/installer/tracked-install.pl \ - tlpkg/installer/install-menu-wizard.pl \ - tlpkg/installer/install-menu-perltk.pl \ texmf-dist/scripts/texlive/tlmgrgui.pl \ + tlpkg/installer/install-menu-text.tcl \ tlpkg/installer/install-tl-gui.tcl \ tlpkg/tltcl/tltcl.tcl \ texmf-dist/scripts/tlshell/tlshell.tcl \ diff --git a/Master/tlpkg/installer/DirSelect.pm b/Master/tlpkg/installer/DirSelect.pm deleted file mode 100644 index 520a0db0bb7..00000000000 --- a/Master/tlpkg/installer/DirSelect.pm +++ /dev/null @@ -1,503 +0,0 @@ -#=============================================================================== -# Tk/DirSelect.pm -# Copyright (C) 2000-2001 Kristi Thompson <kristi@kristi.ca> -# Copyright (C) 2002-2005,2010 Michael Carman <mjcarman@mchsi.com> -# Last Modified: 2/16/2010 -#=============================================================================== -BEGIN { require 5.004 } - -package Tk::DirSelect; -use Cwd; -use File::Spec; -use Tk 800; -require Tk::Frame; -require Tk::BrowseEntry; -require Tk::Button; -require Tk::Label; -require Tk::DirTree; - -use strict; -use base 'Tk::Toplevel'; -Construct Tk::Widget 'DirSelect'; - -use vars qw'$VERSION'; -$VERSION = '1.12'; - -my %colors; -my $isWin32; - -#------------------------------------------------------------------------------- -# Subroutine : ClassInit() -# Purpose : Class initialzation. -# Notes : -#------------------------------------------------------------------------------- -sub ClassInit { - my ($class, $mw) = @_; - $class->SUPER::ClassInit($mw); - - $isWin32 = $^O eq 'MSWin32'; - - # Get system colors from a Text widget for use in DirTree - my $t = $mw->Text(); - foreach my $x (qw'-background -selectbackground -selectforeground') { - $colors{$x} = $t->cget($x); - } - $t->destroy(); -} - - -#------------------------------------------------------------------------------- -# Subroutine : Populate() -# Purpose : Create the DirSelect widget -# Notes : -#------------------------------------------------------------------------------- -sub Populate { - my ($w, $args) = @_; - my $directory = delete $args->{-dir} || cwd(); - my $title = delete $args->{-title} || 'Select Directory'; - - $w->withdraw; - $w->SUPER::Populate($args); - $w->ConfigSpecs(-title => ['METHOD', 'title', 'Title', $title]); - $w->bind('<Escape>', sub { $w->{dir} = undef }); - - my %f = ( - drive => $w->Frame->pack(-anchor => 'n', -fill => 'x'), - button => $w->Frame->pack(-side => 'bottom', -anchor => 's', -fill => 'x', -ipady => 6), - tree => $w->Frame->pack(-fill => 'both', -expand => 1), - ); - - $w->{tree} = $f{tree}->Scrolled('DirTree', - -scrollbars => 'osoe', - -selectmode => 'single', - -ignoreinvoke => 0, - -width => 50, - -height => 15, - %colors, - %$args, - )->pack(-fill => 'both', -expand => 1); - - $w->{tree}->configure(-command => sub { $w->{tree}->opencmd($_[0]) }); - $w->{tree}->configure(-browsecmd => sub { $w->{tree}->anchorClear }); - - $f{button}->Button( - -width => 7, - -text => 'OK', - -command => sub { $w->{dir} = $w->{tree}->selectionGet() }, - )->pack(-side => 'left', -expand => 1); - - $f{button}->Button( - -width => 7, - -text => 'Cancel', - -command => sub { $w->{dir} = undef }, - )->pack(-side => 'left', -expand => 1); - - if ($isWin32) { - $f{drive}->Label(-text => 'Drive:')->pack(-side => 'left'); - $w->{drive} = $f{drive}->BrowseEntry( - -variable => \$w->{selected_drive}, - -browsecmd => [\&_browse, $w->{tree}], - -state => 'readonly', - )->pack(-side => 'left', -fill => 'x', -expand => 1); - - if ($Tk::VERSION >= 804) { - # widget is readonly, but shouldn't appear disabled - for my $e ($w->{drive}->Subwidget('entry')->Subwidget('entry')) { - $e->configure(-disabledforeground => $colors{-foreground}); - $e->configure(-disabledbackground => $colors{-background}); - } - } - } - else { - $f{drive}->destroy; - } - - # right-click context menu - my $menu = $w->Menu( - -tearoff => 0, - -menuitems => [ - [qw/command ~New/, -command => [\&_mkdir , $w]], - [qw/command ~Rename/, -command => [\&_rename, $w]], - [qw/command ~Delete/, -command => [\&_rmdir, $w]], - ], - ); - $menu->bind('<FocusOut>' => sub {$menu->unpost}); - $w->{tree}->bind('<Button-3>' => [\&_context, $menu, Ev('X'), Ev('Y')]); - - # popup overlay for renaming directories - $w->{renameval} = undef; - $w->{popup} = $w->Toplevel(); - $w->{rename} = $w->{popup}->Entry( - -relief => 'groove', - -borderwidth => 1, - )->pack(-fill => 'x', -expand => 1); - $w->{popup}->overrideredirect(1); - $w->{popup}->withdraw; - $w->{rename}->bind('<Escape>', sub {$w->{renameval} = undef}); - $w->{rename}->bind('<FocusOut>', sub {$w->{renameval} = undef}); - $w->{rename}->bind('<KeyPress-Return>', sub {$w->{renameval} = $w->{rename}->get}); - - return $w; -} - - -#------------------------------------------------------------------------------- -# Subroutine : Show() -# Purpose : Display the DirSelect widget. -# Notes : -#------------------------------------------------------------------------------- -sub Show { - my $w = shift; - my $dir = shift; - my $cwd = cwd(); - my $focus = $w->focusSave; - my $grab = $w->grabSave; - - $dir = $cwd unless defined $dir && -d $dir; - chdir($dir); - - if ($isWin32) { - # populate the drive list - my @drives = _get_volume_info(); - $w->{drive}->delete(0, 'end'); - my $startdrive = _drive($dir); - - foreach my $d (@drives) { - $w->{drive}->insert('end', $d); - if ($startdrive eq _drive($d)) { - $w->{selected_drive} = $d; - } - } - } - - # show initial directory - _showdir($w->{tree}, $dir); - - $w->Popup(@_); # show widget - $w->focus; # seize focus - $w->grab; # seize grab - $w->waitVariable(\$w->{dir}); # wait for user selection (or cancel) - $w->grabRelease; # release grab - $w->withdraw; # run and hide - $focus->(); # restore prior focus - $grab->(); # restore prior grab - chdir($cwd) # restore working directory - or warn "Could not chdir() back to '$cwd' [$!]\n"; - - # HList SelectionGet() behavior changed around Tk 804.025 - if (ref $w->{dir} eq 'ARRAY') { - $w->{dir} = $w->{dir}[0]; - } - - { - local $^W; - $w->{dir} .= '/' if ($isWin32 && $w->{dir} =~ /:$/); - } - - return $w->{dir}; -} - - -#------------------------------------------------------------------------------- -# Subroutine : _browse() -# Purpose : Browse to a mounted filesystem (Win32) -# Notes : -#------------------------------------------------------------------------------- -sub _browse { - my ($w, undef, $d) = @_; - $d = _drive($d) . '/'; - chdir($d); - _showdir($w, $d); - - # Workaround: Under Win* versions of Perl/Tk, scrollbars have a tendancy - # to show up but be disabled. - $w->yview(scroll => 1, 'units'); - $w->update; - $w->yview(scroll => -1, 'units'); -} - - -#------------------------------------------------------------------------------- -# Subroutine : _showdir() -# Purpose : Show the requested directory -# Notes : -#------------------------------------------------------------------------------- -sub _showdir { - my $w = shift; - my $dir = shift; - $w->delete('all'); - $w->chdir($dir); -} - - -#------------------------------------------------------------------------------- -# Subroutine : _get_volume_info() -# Purpose : Get volume information (Win32) -# Notes : -#------------------------------------------------------------------------------- -sub _get_volume_info { - require Win32API::File; - - my @drivetype = ( - 'Unknown', - 'No root directory', - 'Removable disk drive', - 'Fixed disk drive', - 'Network drive', - 'CD-ROM drive', - 'RAM Disk', - ); - - my @drives; - foreach my $ld (Win32API::File::getLogicalDrives()) { - my $drive = _drive($ld); - my $type = $drivetype[Win32API::File::GetDriveType($drive)]; - my $label; - - Win32API::File::GetVolumeInformation( - $drive, $label, [], [], [], [], [], []); - - push @drives, "$drive [$label] $type"; - } - - return @drives; -} - - -#------------------------------------------------------------------------------- -# Subroutine : _drive() -# Purpose : Get the drive letter (Win32) -# Notes : -#------------------------------------------------------------------------------- -sub _drive { - shift =~ /^(\w:)/; - return uc $1; -} - - -#------------------------------------------------------------------------------- -# Method : _context -# Purpose : Display the context menu -# Notes : -#------------------------------------------------------------------------------- -sub _context { - my ($w, $m, $x, $y) = @_; - my $wy = $y - $w->rooty; - $w->selectionClear(); - $w->selectionSet($w->nearest($wy)); - $m->post($x, $y); - $m->focus; -} - - -#------------------------------------------------------------------------------- -# Method : _mkdir -# Purpose : Create a new directory under the current selection -# Notes : -#------------------------------------------------------------------------------- -sub _mkdir { - my $w = shift; - my $dt = $w->{tree}; - my ($sel) = $dt->selectionGet(); - - my $cwd = Cwd::cwd(); - if (chdir($sel)) { - my $base = 'NewDirectory'; - my $name = $base; - my $i = 1; - - while (-d $name && $i < 1000) { - $name = $base . $i++; - } - - unless (-d $name) { - if (mkdir($name)) { - _showdir($dt, $sel); - $dt->selectionClear(); - $dt->selectionSet($sel . '/' . $name); - $w->_rename(); - } - else { - $w->messageBox( - -title => 'Unable to create directory', - -message => "The directory '$name' could not be created.\n$!", - -icon => 'error', - -type => 'OK', - ); - } - } - - chdir($cwd); - } - else { - warn "Unable to chdir() for mkdir() [$!]\n"; - } -} - - -#------------------------------------------------------------------------------- -# Method : _rmdir -# Purpose : Delete the selected directory -# Notes : -#------------------------------------------------------------------------------- -sub _rmdir { - my $w = shift; - my $dt = $w->{tree}; - my ($sel) = $dt->selectionGet(); - - my @path = File::Spec->splitdir($sel); - my $dir = pop @path; - my $pdir = File::Spec->catdir(@path); - - my $cwd = Cwd::cwd(); - if (chdir($pdir)) { - if (rmdir($dir)) { - _showdir($dt, $pdir); - } - else { - $w->messageBox( - -title => 'Unable to delete directory', - -message => "The directory '$dir' could not be deleted.\n$!", - -icon => 'error', - -type => 'OK', - ); - } - chdir($cwd); - } - else { - warn "Unable to chdir() for rmdir() [$!]\n"; - } -} - -#------------------------------------------------------------------------------- -# Method : _rename -# Purpose : Rename the selected directory -# Notes : -#------------------------------------------------------------------------------- -sub _rename { - my $w = shift; - my $dt = $w->{tree}; - my $popup = $w->{popup}; - my $entry = $w->{rename}; - my ($sel) = $dt->selectionGet(); - my ($x, $y, $x1, $y1) = $dt->infoBbox($sel); - - my @path = File::Spec->splitdir($sel); - my $dir = pop @path; - my $pdir = File::Spec->catdir(@path); - - $entry->delete(0, 'end'); - $entry->insert(0, $dir); - $entry->selectionRange(0, 'end'); - $entry->focus; - - my $font = ($entry->configure(-font))[4]; - my $text = 'ABCDEFGHIGKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 '; - my $width = $entry->fontMeasure($font, $text) / length($text); - $entry->configure(-width => ($x1 - $x) / $width); - - $popup->Post($dt->rootx + $x, $dt->rooty + $y); - $popup->waitVariable(\$w->{renameval}); - $popup->withdraw; - - if (defined $w->{renameval} && $w->{renameval} ne $dir) { - my $cwd = Cwd::cwd(); - - if (chdir($pdir)) { - unless (rename($dir, $w->{renameval})) { - $w->messageBox( - -title => 'Unable to rename directory', - -message => "The directory '$dir' could not be renamed.\n$!", - -icon => 'error', - -type => 'OK', - ); - } - chdir($cwd); - _showdir($dt, $pdir); # rebrowse to update the display - } - else { - warn "Unable to chdir() for rename() [$!]\n"; - } - } -} - - -1; - -__END__ -=pod - -=head1 NAME - -Tk::DirSelect - Cross-platform directory selection widget. - -=head1 SYNOPSIS - - use Tk::DirSelect; - my $ds = $mw->DirSelect(); - my $dir = $ds->Show(); - -=head1 DESCRIPTION - -This module provides a cross-platform directory selection widget. For -systems running Microsoft Windows, this includes selection of local and -mapped network drives. A context menu (right-click or E<lt>Button3E<gt>) -allows the creation, renaming, and deletion of directories while -browsing. - -Note: Perl/Tk 804 added the C<chooseDirectory> method which uses native -system dialogs where available. (i.e. Windows) If you want a native feel -for your program, you probably want to use that method instead -- -possibly using this module as a fallback for systems with older versions -of Tk installed. - -=head1 METHODS - -=head2 C<DirSelect([-title =E<gt> 'title'], [options])> - -Constructs a new DirSelect widget as a child of the invoking object -(usually a MainWindow). - -The title for the widget can be set by specifying C<-title =E<gt> -'Title'>. Any other options provided will be passed through to the -DirTree widget that displays directories, so be sure they're appropriate -(e.g. C<-width>) - -=head2 C<Show([directory], [options])> - -Displays the DirSelect widget and returns the user selected directory or -C<undef> if the operation is canceled. - -All arguments are optional. The first argument (if defined) is the -initial directory to display. The default is to display the current -working directory. Any additional options are passed through to the -Popup() method. This means that you can do something like - - $ds->Show(undef, -popover => $mw); - -to center the dialog over your application. - -=head1 DEPENDENCIES - -=over 4 - -=item * Perl 5.004 - -=item * Tk 800 - -=item * Win32API::File (under Microsoft Windows only) - -=back - -=head1 LICENSE AND COPYRIGHT - -Copyright 2000-2001 Kristi Thompson <kristi@kristi.ca> -Copyright 2002-2005,2010 Michael Carman <mjcarman@cpan.org> - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See http://dev.perl.org/licenses/ for more information. - -=cut diff --git a/Master/tlpkg/installer/install-menu-extl.pl b/Master/tlpkg/installer/install-menu-extl.pl index 7cf2c4f56cf..24a4d617d9e 100644 --- a/Master/tlpkg/installer/install-menu-extl.pl +++ b/Master/tlpkg/installer/install-menu-extl.pl @@ -1,7 +1,7 @@ #!/usr/bin/env perl # install-menu-extl.pl -# Copyright 2018, 2019 Siep Kroonenberg +# Copyright 2018-2021 Siep Kroonenberg # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -57,15 +57,6 @@ our $MENU_QUIT = 2; my $RETURN = $MENU_INSTALL; -# @fileassocdesc also defined in install-tl -$::fileassocdesc[0] = "None"; -$::fileassocdesc[1] = "Only new"; -$::fileassocdesc[2] = "All"; - -$::deskintdesc[0] = "None"; -$::deskintdesc[1] = "Menu shortcuts"; -$::deskintdesc[2] = "Launcher"; - do_remote_init(); print STDOUT "endload\n\n"; @@ -208,7 +199,7 @@ sub run_menu_extl { } } } # run_menu_extl - $::run_menu = \&run_menu_extl; + 1; diff --git a/Master/tlpkg/installer/install-menu-perltk.pl b/Master/tlpkg/installer/install-menu-perltk.pl deleted file mode 100644 index 905ffc8be67..00000000000 --- a/Master/tlpkg/installer/install-menu-perltk.pl +++ /dev/null @@ -1,1291 +0,0 @@ -#!/usr/bin/env perl -# $Id$ -# -# Copyright 2008-2020 Norbert Preining -# Copyright 2008 Reinhard Kotucha -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -use strict; -$^W = 1; - -my $svnrev = '$Revision$'; -$svnrev =~ m/: ([0-9]+) /; -$::menurevision = ($1 ? $1 : 'unknown'); - -require Tk; -require Tk::Dialog; -require Tk::DialogBox; -require Tk::PNG; -require Tk::BrowseEntry; - -use utf8; -no utf8; - -our %vars; -our $opt_in_place; -our $tlpdb; -our @collections_std; -our $texlive_release; -our @media_available; -our $media; - -our $MENU_INSTALL = 0; -our $MENU_ABORT = 1; -our $MENU_QUIT = 2; -our $MENU_ALREADYDONE = 3; - -my $return = $MENU_INSTALL; - -our $LANG; -our %TRANS; -require("TeXLive/trans.pl"); -load_translations(); - -require("$::installerdir/tlpkg/installer/texdirsel.pl"); - -# @fileassocdesc also defined in install-tl -$::fileassocdesc[0] = __("None"); -$::fileassocdesc[1] = __("Only new"); -$::fileassocdesc[2] = __("All"); - -$::letterdesc[0] = __('A4'); -$::letterdesc[1] = __('letter'); - -$::deskintdesc[0] = __("No shortcuts"); -$::deskintdesc[1] = __("TeX Live menu"); -if (win32() && is_seven()) { $::deskintdesc[2] = __("Launcher entry"); } - -# generic option strings: -$::yesno[0] = __('No'); -$::yesno[1] = __('Yes'); - -our $mw; -my $subframe; -my $mainwindow; -my $bin_toggle_button; -my $scheme_toggle_button; -my $collection_toggle_button; -my $portable_toggle_button; -my $texdir_toggle_button; -my $paper_toggle_button; -my $write_eighteen_toggle_button; -my $format_toggle_button; -my $doc_files_toggle_button; -my $src_files_toggle_button; -my $texworks_toggle_button; -my $load_remote_button; -my $adjustrepo_toggle_button; -my $bintextbutton; -my $schemebutton; -my $tmflocalbutton; -my $tmfsysvarbutton; -my $tmfsysconfigbutton; -my $tmfhomebutton; -my $pathbutton; -my $deskintbutton; -my $assocbutton; -my $adminbutton; -my $installbutton; -my $collectionstext; -my $texmflocaltext; -my $texmfsysvartext; -my $texmfsysconfigtext; -my $texmfhometext; -my $texdirtext; -my $optletterstate; -my $optfmtstate; -my $optsrcstate; -my $optdocstate; -my $portableyesno; -my $letteryesno; -my $fmtyesno; -my $srcyesno; -my $deskintyesno; -my $pathadjyesno; -my $fileassocyesno; -my $editoryesno; -my $adminallyesno; -my $docyesno; -my $restrictedyesno; -my $adjustrepoyesno; - -my $sep = ($^O =~ /^MSWin32/) ? "\\" : "/"; - -$::run_menu = \&run_menu_perltk; - - -#################################################################### -# From here on only function definitions -# ################################################################## - -sub setup_perltk_local_strings { - $portableyesno = $::yesno[$vars{'instopt_portable'}]; - $letteryesno = $::letterdesc[$vars{'instopt_letter'}]; - $fmtyesno = $::yesno[$vars{'tlpdbopt_create_formats'}]; - $srcyesno = $::yesno[$vars{'tlpdbopt_install_srcfiles'}]; - $deskintyesno = $::deskintdesc[$vars{'tlpdbopt_desktop_integration'}]; - $pathadjyesno = $::yesno[$vars{'instopt_adjustpath'}]; - $fileassocyesno = $::fileassocdesc[$vars{'tlpdbopt_file_assocs'}]; - $editoryesno = $::yesno[$vars{'collection-texworks'}]; - $adminallyesno = $::yesno[$vars{'tlpdbopt_w32_multi_user'}]; - $docyesno = $::yesno[$vars{'tlpdbopt_install_docfiles'}]; - $restrictedyesno = $::yesno[$vars{'instopt_write18_restricted'}]; - $adjustrepoyesno = $::yesno[$vars{'instopt_adjustrepo'}]; -} - -sub menu_abort { - $return = $MENU_ABORT; - $mainwindow->destroy; -} - -sub menu_do_it { - $return = $MENU_INSTALL; - $mainwindow->destroy; -} - -sub disable_buttons { - change_button_state('disabled'); -} -sub enable_buttons { - change_button_state('normal'); -} - -sub change_button_state { - my $what = shift; - $installbutton->configure(-state => $what); - $tmflocalbutton->configure(-state => $what); - $tmfsysvarbutton->configure(-state => $what); - $tmfsysconfigbutton->configure(-state => $what); - $tmfhomebutton->configure(-state => $what); - $bin_toggle_button->configure(-state => $what); - $scheme_toggle_button->configure(-state => $what); - $collection_toggle_button->configure(-state => $what); - $portable_toggle_button->configure(-state => $what); - $texdir_toggle_button->configure(-state => $what); - $paper_toggle_button->configure(-state => $what); - $write_eighteen_toggle_button->configure(-state => $what); - $format_toggle_button->configure(-state => $what); - $adjustrepo_toggle_button->configure(-state => $what); - $pathbutton->configure(-state => $what); - $doc_files_toggle_button->configure(-state => $what) - if defined($doc_files_toggle_button); - $src_files_toggle_button->configure(-state => $what) - if defined($src_files_toggle_button); - $texworks_toggle_button->configure(-state => $what) - if defined($texworks_toggle_button); -} - -sub run_menu_perltk { - if ($::opt_select_repository) { - } else { - do_remote_init(); - setup_perltk_local_strings(); - calc_depends(); - } - $mainwindow = Tk::MainWindow->new; - $mainwindow->protocol('WM_DELETE_WINDOW' => \&menu_abort); - - # Taco once reported for 2010 that using these scrolled pane - # on Windows just died - # with the proliferation of netbooks and a new perl installed - # let us try to go back to using scrolled pane on both unix and windows - require Tk::Pane; - $subframe = $mainwindow->Scrolled("Frame", -scrollbars => "oe"); - $mw = $subframe->Frame; - - # image frame on the left - my $fl = $mw->Frame(-background => "#0078b8"); - my $img = $fl->Photo(-format => 'png', - -file => "$::installerdir/tlpkg/installer/texlive.png"); - $fl->Label(-image => $img, -background => "#0078b8") - ->pack(-expand => 1, -fill => "y"); - $fl->Label( - -text => "v$::installerrevision/$::menurevision", - -background => "#0078b8")->pack; - - # data frame on the right - my $fr = $mw->Frame; - $fl->pack(-side => 'left', -expand => 1, -fill => "y"); - $fr->pack(-side => 'right'); - - - my $row = 1; - $fr->Label( - -text => __("TeX Live %s Installation", $TeXLive::TLConfig::ReleaseYear)) - ->grid(-row => $row, -column => 1, -columnspan => 3); - - if ($::opt_select_repository) { - $row++; - my @mirror_list; - my @netlst; - my @loclst; - if ($#media_available >= 0) { - for my $l (@media_available) { - my ($a, $b) = split ('#', $l); - if ($a eq 'local_compressed' || $a eq 'local_uncompressed') { - push @loclst, " $b"; - } elsif ($a eq 'NET') { - push @netlst, " " . __("Command line repository") . ": $b"; - } else { - tlwarn("Unknown media $l\n"); - } - } - if ($#loclst >= 0) { - push @mirror_list, __("LOCAL REPOSITORIES"); - push @mirror_list, @loclst; - } - } - push @mirror_list, __("NETWORK REPOSITORIES"); - push @mirror_list, - " " . __("Default remote repository") . ": http://mirror.ctan.org"; - push @mirror_list, @netlst; - push @mirror_list, TeXLive::TLUtils::create_mirror_list(); - my $mirror_entry; - $fr->Label( - -text => __('Select repository'), - -anchor => 'w')->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->BrowseEntry( - -state => 'readonly', - -listheight => 12, - -listwidth => 400, - -width => 35, - -autolistwidth => 1, - -choices => \@mirror_list, - -browsecmd => - sub { - if ($mirror_entry !~ m/^ /) { - $mirror_entry = ""; - } elsif ($mirror_entry =~ m!(http|ftp)://!) { - $mirror_entry = - TeXLive::TLUtils::extract_mirror_entry($mirror_entry); - } else { - $mirror_entry =~ s/^\s*//; - # $mirror_entry = - # TeXLive::TLUtils::extract_mirror_entry($mirror_entry); - } - }, - -variable => \$mirror_entry) - ->grid(-row => $row, -column => 2, -sticky => 'w'); - $load_remote_button = $fr->Button(-text => __("Load"), - -command => sub { - $::init_remote_needed = 1; - my $mfull = $mirror_entry; - only_load_remote($mfull); - if (!only_load_remote($mfull)) { - $fr->Dialog(-title => __("Warning"), - -text => __('Could not load remote TeX Live Database:') . $mfull - . "\n\n" . - __('Please select a different mirror.'), - -buttons => [ __("Ok") ])->Show; - $mirror_entry = ""; - } elsif (!do_version_agree()) { - $fr->Dialog( - -title => __("Warning"), - -text => __( - 'The TeX Live versions of the local installation and the repository being accessed are not compatible: - local: %s - repository: %s -Please select a different mirror.', - $TeXLive::TLConfig::ReleaseYear, $texlive_release), - -buttons => [ __("Ok") ])->Show; - $mirror_entry = ""; - } else { - $load_remote_button->configure(-state => 'disable'); - final_remote_init($mfull); - setup_perltk_local_strings(); - calc_depends(); - menu_update_texts(); - enable_buttons(); - } - })->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - if (!$opt_in_place) { - - $row++; - $fr->Label(-text => "------- " . __("Basic Information") . " -------") - ->grid(-row => $row, -column => 1, -columnspan => 3); - - # binary system line - if (!win32()) { - $row++; - $fr->Label(-text => __('Binary system(s)'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $bintextbutton = $fr->Label(-anchor => 'w'); - $bintextbutton->grid(-row => $row, -column => 2, -padx => "2m"); - $bin_toggle_button = $fr->Button( - -text => __("Change"), -command => sub { menu_select_binsystems(); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - $row++; - - # scheme line - $fr->Label(-text => __('Selected scheme'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $schemebutton = $fr->Label(-anchor => 'w'); - $schemebutton->grid(-row => $row, -column => 2, -padx => "2m"); - $scheme_toggle_button = $fr->Button( - -text => __("Change"), -command => sub { menu_select_scheme(); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - - # further customization - $fr->Label(-text => "------- " . __("Further Customization") . " -------") - ->grid(-row => $row, -column => 1,-columnspan => 3); - - $row++; - # collection line - $fr->Label(-text => __('Installation collections'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $collection_toggle_button = $fr->Button( - -text => __("Change"), - -command => sub { menu_select_standard_collections(); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - $collectionstext = $fr->Label(); - $collectionstext->grid(-row => $row, -column => 1, -columnspan => 3); - } - - $row++; - # further customization - $fr->Label(-text => "------- " . __("Directory setup") . " -------") - ->grid(-row => $row, -column => 1, -columnspan => 3); - - $row++; - $fr->Label(-text => __('Portable setup'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$portableyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $portable_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { toggle_portable(); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texdir line - $fr->Label(-text => __('TEXDIR (the main TeX directory)'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $texdirtext = $fr->Label(-anchor => 'w') - ->grid(-row => $row, -column => 2, -padx => "2m"); - if (!$opt_in_place) { - $texdir_toggle_button = $fr->Button( - -text => __("Change"), -command => \&change_path) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - - $row++; - # texmflocal line - $fr->Label( - -text => __('TEXMFLOCAL (directory for site-wide local files)'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmflocaltext = $fr->Label(-anchor => 'w') - ->grid(-row => $row, -column => 2, -padx => "2m"); - $tmflocalbutton = $fr->Button( - -text => __("Change"), - -command => sub { menu_edit_vars_value("TEXMFLOCAL"); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfsysvar line - $fr->Label( - -text => __('TEXMFSYSVAR (directory for autogenerated data)'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfsysvartext = $fr->Label(-anchor => 'w') - ->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfsysvarbutton = $fr->Button( - -text => __("Change"), - -command => sub { menu_edit_vars_value("TEXMFSYSVAR"); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfsysconfig line - $fr->Label( - -text => __('TEXMFSYSCONFIG (directory for local config)'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfsysconfigtext = $fr->Label(-anchor => 'w') - ->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfsysconfigbutton = $fr->Button( - -text => __("Change"), - -command => sub { menu_edit_vars_value("TEXMFSYSCONFIG"); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - # texmfhome line - $fr->Label( - -text => __('TEXMFHOME (directory for user-specific files)'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $texmfhometext = $fr->Label(-anchor => 'w') - ->grid(-row => $row, -column => 2, -padx => "2m"); - $tmfhomebutton = $fr->Button( - -text => __("Change"), - -command => sub { menu_edit_vars_value("TEXMFHOME"); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($vars{'instopt_portable'}) { - for my $b ( - $tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'disabled') - } - } - - $row++; - # Options - $fr->Label(-text => "------- " . __("Options") . " -------") - ->grid(-row => $row, -column => 1, -columnspan => 3); - - $row++; - # optpaper - $fr->Label(-text => __('Default paper size'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$letteryesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $paper_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'instopt_letter'}, \$letteryesno, \@::letterdesc); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - $fr->Label( - -text => __('Allow execution of restricted list of programs via \write18'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$restrictedyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $write_eighteen_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'instopt_write18_restricted'}, - \$restrictedyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - $fr->Label( - -text => __('Create all format files'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$fmtyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $format_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable(\$vars{'tlpdbopt_create_formats'}, \$fmtyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($vars{'doc_splitting_supported'} and !$opt_in_place) { - $row++; - $fr->Label(-text => __('Install font/macro doc tree'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$docyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $doc_files_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable(\$vars{'tlpdbopt_install_docfiles'}, \$docyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - if ($vars{'src_splitting_supported'} and !$opt_in_place) { - $row++; - $fr->Label(-text => __('Install font/macro source tree'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$srcyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $src_files_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable(\$vars{'tlpdbopt_install_srcfiles'}, \$srcyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - $row++; - $fr->Label( - -text => (win32()) ? __('Adjust PATH setting in registry') : - __('Create symlinks in system directories'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$pathadjyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - if (unix()) { - $pathbutton = $fr->Button( - -text => __("Change"), -command => sub { menu_select_symlink(); }); - } else { - $pathbutton = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable(\$vars{'instopt_adjustpath'}, \$pathadjyesno); }); - } - $pathbutton->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($::opt_all_options || win32()) { - $row++; - $fr->Label(-text => __('Add menu shortcuts'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$deskintyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $deskintbutton = $fr->Button( - -text => __("Change"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'tlpdbopt_desktop_integration'}, - \$deskintyesno, \@::deskintdesc); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - $row++; - $fr->Label(-text => __('Change file associations'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$fileassocyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $assocbutton = $fr->Button( - -text => __("Change"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'tlpdbopt_file_assocs'}, \$fileassocyesno, \@::fileassocdesc); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - - if ($::opt_all_options || admin()) { - $row++; - $fr->Label(-text => __('Installation for all users'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$adminallyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $adminbutton = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'tlpdbopt_w32_multi_user'}, \$adminallyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - $row++; - $fr->Label(-text => __('Install TeXworks front end'), -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$editoryesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - if (!$opt_in_place) { - $texworks_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'collection-texworks'}, \$editoryesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - } - if ($media ne 'NET') { - $row++; - $fr->Label( - -text => __('After install, set CTAN as source for package updates'), - -anchor => 'w') - ->grid(-row => $row, -column => 1, -sticky => 'w'); - $fr->Label(-anchor => 'w', -textvariable => \$adjustrepoyesno) - ->grid(-row => $row, -column => 2, -padx => "2m"); - $adjustrepo_toggle_button = $fr->Button( - -text => __("Toggle"), - -command => sub { - toggle_and_set_opt_variable( - \$vars{'instopt_adjustrepo'}, \$adjustrepoyesno); }) - ->grid(-row => $row, -column => 3, -sticky => "ew", -padx => "2m"); - } - - if ($vars{'instopt_portable'}) { - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'disabled') if $b; - } - } - - # install/cancel buttons - my $f3 = $fr->Frame; - $f3->Button( - -text => __("About"), - -command => sub { - my $sw = $mw->DialogBox(-title => __("About"), - -buttons => [ __("Ok") ]); - $sw->add("Label", -text => " -TeX Live $TeXLive::TLConfig::ReleaseYear -Please see http://www.tug.org/texlive -GUI installer -Copyright 2009-$TeXLive::TLConfig::ReleaseYear The TeX Live Team -Licensed under the GNU General Public License version 2 or higher - -In case of problems, please contact: texlive\@tug.org" - )->pack(-ipadx => "2m", -ipady => "2m"); - $sw->Show; - })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - - - - $installbutton = $f3->Button( - -text => __("Install TeX Live"), - -command => \&menu_do_it - )->pack(-side => 'left', -padx => "2m", -pady => "2m")->focus(); - my $quitbutton = $f3->Button( - -text => __("Quit"), - -command => \&menu_abort - )->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $mw->bind('<Escape>', [ $quitbutton, 'Invoke' ]); - #my $wizardbutton = $f3->Button( - # -text => __("Wizard"), - # -command => sub { - # $mainwindow->destroy; - # require("installer/install-menu-wizard.pl"); - # setup_hooks_wizard(); - # $return = run_menu_wizard(); - # })->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $row++; - $f3->grid(-row => $row, -column => 1, -columnspan => 3); - if (!$::opt_select_repository) { - menu_update_texts(); - } else { - disable_buttons(); - } - $fr->gridColumnconfigure(2, -minsize => 300); - $mw->pack(-expand => 1, -fill => "both"); - $mw->update; - my $rh = $mw->reqheight; - my $rw = $mw->reqwidth; - my $maxheight = $mainwindow->screenheight() - 20; - debug( - "Requested height: $rh, requested width: $rw, max height: $maxheight\n"); - if ($rh > $maxheight) { - $rh = $maxheight; - $rw += 20; # for the scrollbar = = - } - $subframe->configure(-height => $rh, -width=>$rw); - $subframe->pack(-expand => 1, -fill => "both"); - $mainwindow->configure(-height => $rh, -width=>$rw); - $mainwindow->geometry("=${rw}x${rh}"); - #$mw->pack(-expand => 1, -fill => "both"); - - if (win32() && pre_warn($mainwindow)) { return $MENU_ABORT; } - - Tk::MainLoop(); - return($return); -} - -sub pre_warn { - my $parent = shift; - require TeXLive::TLWinGoo; - my ($b_quit, $b_cont) = (__('Quit'), __('Continue')); - my $wrn = __( - 'In case of trouble, try disabling your virus scanner during installation.'); - if (!admin()) { - $wrn .= "\n\n". - __("The installer does not have adminstrative permissions;\nso can only install for current user."); - if (is_vista()) { - $wrn .= "\n\n". - __("Right-click install-tl-advanced and select \"run as administrator\"\n if you want to install for all users."); - } - } - my $ans = $parent->Dialog( - -title => __("TeX Live %s Installation", $TeXLive::TLConfig::ReleaseYear), - -text => $wrn, - -default_button => $b_cont, - -buttons => [$b_quit, $b_cont])->Show(); - return $ans eq $b_quit; -} - -# this sub will not be called if $opt_in_place -sub menu_edit_texdir { - my $key = shift; - our $addyear = 1; - our $addtexlive = 1; - my $val = $vars{$key}; - our $currsel; - our $entry; - sub update_label { - my $t = $currsel; - $t .= "/texlive" if ($addtexlive); - $t .= "/$texlive_release" if ($addyear); - $entry->configure(-text => "$t"); - } - my $hint_var; - if ($key ne 'TEXMFHOME') { - $hint_var = win32() ? $ENV{'USERPROFILE'} : $ENV{'HOME'}; - } else { - $hint_var = win32() ? '%USERPROFILE%' : '$HOME'; - } - if ($val =~ m!^(.*)/texlive/$texlive_release$!) { - $currsel = "$1"; - $addyear = 1; - $addtexlive = 1; - } elsif ($val =~ m!^(.*)/$texlive_release$!) { - $currsel = "$1"; - $addyear = 1; - $addtexlive = 0; - } elsif ($val =~ m!^(.*)/texlive$!) { - $currsel = "$1"; - $addyear = 0; - $addtexlive = 1; - } else { - $addyear = 0; - $addtexlive = 0; - $currsel = $val; - } - my $sw = $mainwindow->Toplevel(-title => __("Change variable value")); - $sw->transient($mainwindow); - $sw->grab(); - $sw->Label(-text => __("Enter path for %s (use ~ for %s)", $key, $hint_var)) - ->pack(-padx => "2m", -pady => "2m"); - $entry = $sw->Entry(-width => 60)->pack(-padx => "2m", -pady => "2m"); - my $f = $sw->Frame; - my $c1 = $f->Checkbutton( - -text => 'Add "texlive"', - -variable => \$addtexlive, - -command => \&update_label); - my $c2 = $f->Checkbutton( - -text => "Add \"$texlive_release\"", -variable => \$addyear, - -command => \&update_label); - my $foo = $sw->Scrolled( - "DirTree", -scrollbars => "osoe", - -browsecmd => sub { my ($d) = @_; $currsel = $d; update_label(); }, - -directory => "$currsel"); - my $ff = $sw->Frame; - my $ok = $ff->Button( - -text => __("Ok"), - -command => sub { - $val = $entry->get; - callback_edit_directories($key,$val); - $sw->destroy; }); - my $cancel = $ff->Button( - -text => __("Cancel"), - -command => sub { $sw->destroy; }); - update_label(); - $c1->pack(-side => "left", -padx => "2m", -pady => "2m"); - $c2->pack(-side => "right", -padx => "2m", -pady => "2m"); - $f->pack; - $foo->pack(-fill => "both", -expand => 1); - $ok->pack(-side => 'left' , -padx => "2m", -pady => "2m"); - $cancel->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $ff->pack; - # bindings - $sw->bind('<Return>' => [ $ok, 'Invoke']); - $sw->bind('<Escape>' => [ $cancel, 'Invoke']); -} - -sub menu_edit_vars_value { - my $key = shift; - my $sw = $mainwindow->Toplevel(-title => __("Change variable value")); - $sw->transient($mainwindow); - $sw->grab(); - my $val = $vars{$key}; - my $hint_var; - if ($key ne 'TEXMFHOME') { - $hint_var = win32() ? $ENV{'USERPROFILE'} : $ENV{'HOME'}; - } else { - $hint_var = win32() ? '%USERPROFILE%' : '$HOME'; - } - $sw->Label(-text => __("Enter path for %s (use ~ for %s)", $key, $hint_var)) - ->pack(-padx => "2m", -pady => "2m"); - my $entry = $sw->Entry(-text => native_slashify($val), -width => 60); - $entry->pack(-padx => "2m", -pady => "2m")->focus(); - my $f = $sw->Frame; - my $okbutton = $f->Button( - -text => __("Ok"), - -command => sub { - $val = forward_slashify($entry->get); - callback_edit_directories($key,$val) ; - $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'); - # bindings - $sw->bind('<Return>' => [ $okbutton, 'Invoke']); - $sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']); -} - - -sub menu_select_scheme { - my $sw = $mainwindow->Toplevel(-title => __('Selected scheme')); - $sw->transient($mainwindow); - $sw->grab(); - my @schemes; - foreach my $pkg ($tlpdb->list_packages) { - my $tlpobj = $tlpdb->{'tlps'}{$pkg}; - if ($tlpobj->category eq "Scheme") { - push @schemes, $pkg; - $vars{"$pkg"}=($vars{'selected_scheme'} eq $pkg)? 1:0; - } - } - my @scheme_order = schemes_ordered_for_presentation(); - push @scheme_order, "scheme-custom"; - my $selected = $vars{'selected_scheme'}; - $sw->Label(-text => __("Selected scheme")) - ->pack(-padx => "2m", -pady => "2m"); - my $f2 = $sw->Frame; - foreach my $scheme (@scheme_order) { - my $desc; - if ($scheme ne "scheme-custom") { - my $tlpobj = $tlpdb->get_package("$scheme"); - $desc = $tlpobj->shortdesc; - } else { - $desc = __("custom selection of collections"); - } - my $b; - $b = $f2->Radiobutton( - -variable => \$selected, -value => $scheme, - -text => __($desc), - -justify => 'left', -wraplength => 500) - ->pack(-anchor => 'w', -pady => "1m"); - if ($selected eq $scheme) { - $b->focus(); - } - } - $f2->pack; - my $f3 = $sw->Frame; - my $okbutton = $f3->Button( - -text => __("Ok"), - -command => sub { callback_select_scheme($selected) ; $sw->destroy }) - ->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f3->Button( - -text => __("Cancel"), -command => sub { $sw->destroy }) - ->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f3->pack(-expand => 'x'); - $sw->bind('<Return>' => [ $okbutton, 'Invoke']); - $sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_standard_collections { - my $sw = $mainwindow->Toplevel(-title => __('Installation collections')); - $sw->transient($mainwindow); - $sw->grab(); - my $fb = $sw->Frame; - my $fc = $sw->Frame; - my $fd = $sw->Frame; - my $f1 = $fb->Frame; - my $f2 = $fb->Frame; - my $f3 = $fb->Frame; - my %lvars = %vars; - $sw->Label(-text => __("Select the collections to be installed")) - ->pack(-padx => "2m", -pady => "2m"); - my $onethirdcol = $#collections_std / 3; - my $twothirdcol = 2 * $onethirdcol; - my $i = 0; - foreach my $coll (sort @collections_std) { - my $tlpobj = $tlpdb->get_package("$coll"); - if ($i < $onethirdcol) { - $f1->Checkbutton( - -variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc)) - ->pack(-anchor => 'w'); - } elsif ($i < $twothirdcol) { - $f2->Checkbutton( - -variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc)) - ->pack(-anchor => 'w'); - } else { - $f3->Checkbutton( - -variable => \$lvars{$coll}, -text => __($tlpobj->shortdesc)) - ->pack(-anchor => 'w'); - } - $i++; - } - $f1->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f2->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $f3->pack(-side => 'left', -padx => "2m", -pady => "2m"); - $fb->pack(-padx => "2m", -pady => "2m"); - $fc->pack(-side => 'left', -expand => 'x', -padx => "2m", -pady => "2m"); - $fc->Button( - -text => __("Select All"), - -command => sub { select_collections(\%lvars, @collections_std) }) - ->pack(-side => 'left', -padx => "2m", -pady => "2m")->focus(); - $fc->Button( - -text => __("Deselect All"), - -command => sub { deselect_collections(\%lvars, @collections_std) }) - ->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $fd->pack(-side => 'left', -expand => 'x', -padx => "2m", -pady => "2m"); - my $okbutton = $fd->Button(-text => __("Ok"), - -command => sub { - # we call the update only if something has changed - my $changed = 0; - for my $k (keys %lvars) { - if ($vars{$k} ne $lvars{$k}) { - $changed = 1; - last; - } - } - if ($changed) { - %vars = %lvars; - callback_select_collection(); - } - $sw->destroy; - })->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $fd->Button( - -text => __("Cancel"), -command => sub { $sw->destroy }) - ->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $sw->bind('<Return>' => [ $okbutton, 'Invoke']); - $sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_symlink { - our ($lbin,$lman,$linfo); - our $osym = $vars{'instopt_adjustpath'}; - our ($binlab,$binb,$manlab,$manb,$infolab,$infob); - sub set_unset_buttons { - $lbin = ($osym ? $vars{'tlpdbopt_sys_bin'} : ''); - $linfo = ($osym ? $vars{'tlpdbopt_sys_info'} : ''); - $lman = ($osym ? $vars{'tlpdbopt_sys_man'} : ''); - if ($osym) { - $binb->configure (-state => 'normal'); - $manb->configure (-state => 'normal'); - $infob->configure(-state => 'normal'); - } else { - $infob->configure(-state => 'disabled'); - $manb->configure (-state => 'disabled'); - $binb->configure (-state => 'disabled'); - } - } - sub return_callback { - if ($osym) { - my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if (win32()); - $home ||= '~'; - $lbin =~ s/^~/$home/; - $linfo =~ s/^~/$home/; - $lman =~ s/^~/$home/; - $vars{'tlpdbopt_sys_bin'} = $lbin; - $vars{'tlpdbopt_sys_info'} = $linfo; - $vars{'tlpdbopt_sys_man'} = $lman; - } - toggle_and_set_opt_variable(\$vars{'instopt_adjustpath'}, \$osym); - $pathadjyesno = $osym; - } - my $sw = $mainwindow->Toplevel( - -title => __('Create symlinks in system directories')); - $sw->transient($mainwindow); - $sw->grab(); - $sw->Checkbutton( - -variable => \$osym, - -text => __("create symlinks in standard directories"), - -command => sub { set_unset_buttons(); } ) - ->grid(-column => 1, -row => 1, -columnspan => 2, -padx => "2m"); - $binlab = $sw->Label(-text => __("binaries to")); - $binb = $sw->Entry(-textvariable => \$lbin); - $manlab = $sw->Label(-text => __("manpages to")); - $manb = $sw->Entry(-textvariable => \$lman); - $infolab = $sw->Label(-text => __("info to")); - $infob = $sw->Entry(-textvariable => \$linfo); - $binlab->grid(-row => 2, -column => 1, -sticky => "w", -padx => "2m"); - $binb->grid(-row => 2, -column => 2, -sticky => "ew", -padx => "2m"); - $manlab->grid(-row => 3, -column => 1, -sticky => "w", -padx => "2m"); - $manb->grid(-row => 3, -column => 2, -sticky => "ew", -padx => "2m"); - $infolab->grid(-row => 4, -column => 1, -sticky => "w", -padx => "2m"); - $infob->grid(-row => 4, -column => 2, -sticky => "ew", -padx => "2m"); - set_unset_buttons(); - my $f2 = $sw->Frame; $f2->grid(-column => 1, -columnspan => 2, -row => 5); - my $okbutton = $f2->Button( - -text => __("Ok"), -command => sub { return_callback(); $sw->destroy }) - ->pack(-side => 'left'); - my $cancelbutton = $f2->Button(-text => __("Cancel"), - -command => sub { $sw->destroy })->pack(-side => 'right'); - $sw->bind('<Return>' => [ $okbutton, 'Invoke']); - $sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']); -} - -sub menu_select_binsystems { - my $f2r; - my $f2; - my $sw = $mainwindow->Toplevel(-title => __('Binary system(s)')); - $sw->transient($mainwindow); - $sw->grab(); - my @diskarchs = (); - foreach my $key (keys %vars) { - if ($key=~/binary_(.*)/) { - push @diskarchs, $1; - } - } - $sw->Label(-text => __("Select arch-os"))->pack(-padx => "2m", -pady => "2m"); - $f2 = $sw->Frame; - my $f2l = $f2->Frame; - foreach my $sys (sort TeXLive::TLUtils::sort_archs @diskarchs) { - $f2l->Checkbutton(-variable => \$vars{"binary_$sys"}, - -command => sub { check_on_removal($sw, $sys); }, - -text => platform_desc($sys))->pack(-anchor => 'w'); - } - $f2l->pack(-side => 'left'); - $f2->pack(-padx => "2m", -pady => "2m"); - my $f3 = $sw->Frame; - my $okbutton = $f3->Button( - -text => __("Ok"), - -command => sub { callback_select_systems() ; $sw->destroy }) - ->pack(-side => 'left', -padx => "2m", -pady => "2m"); - my $cancelbutton = $f3->Button( - -text => __("Cancel"), - -command => sub { $sw->destroy }) - ->pack(-side => 'right', -padx => "2m", -pady => "2m"); - $f3->pack(-expand => 'x'); - $sw->bind('<Return>' => [ $okbutton, 'Invoke']); - $sw->bind('<Escape>' => [ $cancelbutton, 'Invoke']); -} - -sub check_on_removal { - my $arch_frame = shift; - my $a = shift; - if (!$vars{"binary_$a"} && $a eq $vars{'this_platform'}) { - # removal not supported - $vars{"binary_$a"} = 1; - $arch_frame->Dialog( - -title => __("Warning"), - -text => __("Removals of the main platform not possible!"), - -buttons => [ __("Ok") ])->Show; - } -} - - -sub menu_set_text { - my $w = shift; - my $t = shift; - # if in_place or portable not a complete interface - $w->configure(-text => $t, @_) if $w; -} - -sub menu_set_schemebutton_text { - menu_set_text($schemebutton, "$vars{'selected_scheme'}"); -} - -sub menu_set_binbutton_text { - if (!win32()) { - if ($vars{'n_systems_selected'} == 1) { - my $selsys; - foreach my $key (keys %vars) { - if ($key=~/binary_(.*)/) { - if ($vars{$key}) { - $selsys = $1; - # we have only one system selected, stop here - last; - } - } - } - menu_set_text($bintextbutton, $selsys); - } else { - menu_set_text( - $bintextbutton, __( - "%s out of %s", $vars{'n_systems_selected'}, - $vars{'n_systems_available'})); - } - } -} - -sub menu_set_collections_text { - menu_set_text($collectionstext, __("%s collections out of %s", - $vars{'n_collections_selected'}, $vars{'n_collections_available'}) - . " (" . __("disk space required:") . " $vars{'total_size'} MB)"); -} - -sub menu_set_pathes_text { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text( - $texdirtext, native_slashify($vars{'TEXDIR'}), - -foreground => "black"); - } else { - menu_set_text( - $texdirtext, - __("(default not allowed or not writable - please change!)"), - -foreground => "red"); - } - menu_set_text($texmflocaltext, native_slashify($vars{'TEXMFLOCAL'})); - if ((-w $vars{'TEXMFSYSVAR'}) || (-w dirname($vars{'TEXMFSYSVAR'}))) { - menu_set_text( - $texmfsysvartext, native_slashify($vars{'TEXMFSYSVAR'}), - -foreground => "black"); - } elsif ("$vars{'TEXMFSYSVAR'}" =~ m;^$vars{'TEXDIR'};) { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text( - $texmfsysvartext, native_slashify($vars{'TEXMFSYSVAR'}), - -foreground => "black"); - } else { - menu_set_text( - $texmfsysvartext, __("(please change TEXDIR first!)"), - -foreground => "red"); - } - } else { - menu_set_text( - $texmfsysvartext, __("(default not writable - please change!)")); - } - if ((-w $vars{'TEXMFSYSCONFIG'}) || (-w dirname($vars{'TEXMFSYSCONFIG'}))) { - menu_set_text( - $texmfsysconfigtext, native_slashify($vars{'TEXMFSYSCONFIG'}), - -foreground => "black"); - } elsif ("$vars{'TEXMFSYSCONFIG'}" =~ m;^$vars{'TEXDIR'};) { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - menu_set_text( - $texmfsysconfigtext, native_slashify($vars{'TEXMFSYSCONFIG'}), - -foreground => "black"); - } else { - menu_set_text( - $texmfsysconfigtext, __("(please change TEXDIR first!)"), - -foreground => "red"); - } - } else { - menu_set_text( - $texmfsysconfigtext, __("(default not writable - please change!)")); - } - menu_set_text($texmfhometext, native_slashify($vars{'TEXMFHOME'})); -} - - -sub menu_update_texts { - menu_set_pathes_text; - menu_set_collections_text; - menu_set_binbutton_text; - menu_set_schemebutton_text; - $optletterstate = $::letterdesc[$vars{'instopt_letter'}]; - $optfmtstate = ($vars{'tlpdbopt_create_formats'} ? __("Yes") : __("No")); - $optsrcstate = ($vars{'tlpdbopt_install_srcfiles'} ? __("Yes") : __("No")); - $optdocstate = ($vars{'tlpdbopt_install_docfiles'} ? __("Yes") : __("No")); -} - -sub callback_select_scheme { - my $s = shift; - select_scheme($s); - $editoryesno = ($vars{'collection-texworks'} ? __("Yes") : __("No")); - menu_update_texts(); -} - -sub callback_select_collection { - # special case for collection-texworks: - $editoryesno = ($vars{'collection-texworks'} ? __("Yes") : __("No")); - calc_depends(); - select_scheme("scheme-custom"); - update_numbers(); - menu_update_texts(); -} - -sub callback_select_systems() { - if ($vars{"binary_win32"}) { - $vars{"collection-wintools"} = 1; - } else { - $vars{"collection-wintools"} = 0; - } - calc_depends(); - update_numbers(); - menu_update_texts(); -} - -sub callback_change_texdir { - my $val = shift; - callback_edit_directories('TEXDIR', $val); -} - -sub callback_edit_directories { - my ($key,$val) = @_; - my $home = getenv('HOME'); - if (win32()) { - $home = getenv('USERPROFILE'); - $home =~ s!\\!/!g; - } - $home ||= '~'; - $val =~ s!\\!/!g; - $vars{$key} = $val; - $vars{'TEXDIR'} =~ s/^~/$home/; - $vars{'TEXMFLOCAL'} =~ s/^~/$home/; - $vars{'TEXMFSYSVAR'} =~ s/^~/$home/; - $vars{'TEXMFSYSCONFIG'} =~ s/^~/$home/; - # only if we set TEXDIR we set the others in parallel - my $texdirnoslash; - if ($key eq "TEXDIR") { - if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { - $texdirnoslash = $1; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/$texlive_release/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/$texlive_release/texmf-config"; - } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { - $texdirnoslash = $1; - $texdirnoslash =~ s!/$!!; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/texmf-config"; - } - } - menu_update_texts(); -} - -sub callback_edit_var() { - my ($key,$val) = @_; - $vars{$key} = $val; - menu_update_texts(); -} - -#sub dump_vars_stdout { -# foreach my $k (keys %vars) { -# print "DEBUG: vars{$k} = $vars{$k}\n"; -# } -#} - -sub toggle_portable { - my $td = $vars{'TEXDIR'}; - my $b; - if ($vars{'instopt_portable'}) { - $vars{'instopt_portable'} = 0; - $portableyesno = __('No'); - # enable some buttons - for $b ( - $tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'normal'); - } - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'normal') if $b; - } - } else { - $vars{'instopt_portable'} = 1; - $portableyesno = __('Yes'); - # disable some buttons. These should get a name first. - for $b ( - $tmflocalbutton, $tmfsysvarbutton, $tmfsysconfigbutton, $tmfhomebutton) { - $b->configure(-state => 'disabled'); - } - $vars{'instopt_adjustpath'} = 0; - $vars{'tlpdbopt_desktop_integration'} = 0; - $vars{'tlpdbopt_file_assocs'} = 0; - $vars{'tlpdbopt_w32_multi_user'} = 0; - $deskintyesno = __("No"); - $pathadjyesno = __("No"); - $fileassocyesno = __("None"); - $adminallyesno = __("No"); - for $b ($pathbutton, $deskintbutton, $assocbutton, $adminbutton) { - $b->configure(-state => 'disabled') if $b; - } - } - set_texlive_default_dirs(); # this sub tests for portable and in_place - $mw -> messageBox( - -title => __('Warning'), - -message => - __("Portable option changed;\nDirectories have been reinitialized"), - -type => 'OK', -icon => 'warning'); - menu_set_pathes_text(); - # same for some options -} - -sub toggle_and_set_opt_variable { - # $varsref: the variable to be changed - # $toggleref: the string representation of the value of $varsref; - # $choicesref: array ref of possible values for $toggleref - my ($varsref, $toggleref, $choicesref) = @_; - $choicesref = \@::yesno unless defined $choicesref; - - my $n_opts = @$choicesref; - $$varsref += 1; - $$varsref = 0 if $$varsref >= $n_opts; - $$toggleref = $$choicesref[$$varsref]; - calc_depends(); - menu_update_texts(); -} - -1; - -__END__ - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/installer/install-menu-text.pl b/Master/tlpkg/installer/install-menu-text.pl index 7229b6928ac..9cc79fe8ebb 100644 --- a/Master/tlpkg/installer/install-menu-text.pl +++ b/Master/tlpkg/installer/install-menu-text.pl @@ -33,14 +33,14 @@ my $ptoggle_alert = "\n". " !! Portable option changed;\n" . " !! Directories have been reinitialized!\n"; -# @fileassocdesc also defined in install-tl -$::fileassocdesc[0] = "None"; -$::fileassocdesc[1] = "Only new"; -$::fileassocdesc[2] = "All"; +# some strings to describe the different meanings of tlpdbopt_file_assoc +$::fileassocdesc[0] = __("None"); +$::fileassocdesc[1] = __("Only new"); +$::fileassocdesc[2] = __("All"); -$::deskintdesc[0] = "None"; -$::deskintdesc[1] = "Menu shortcuts"; -if (win32() && is_seven()) { $::deskintdesc[2] = "Launcher"; } +$::deskintdesc[0] = __("None"); +$::deskintdesc[1] = __("Menu shortcuts"); +if (win32()) { $::deskintdesc[2] = __("Launcher"); } sub clear_screen { return 0 if ($::opt_no_cls); @@ -52,9 +52,6 @@ sub string_to_list { return split(//, $string); } -# ___, defined in install-tl, replaces the GUI translating function -*::__ = \&::___; - sub button { # for main menu: 1 char my $val=shift; my $vals=shift; # array ref to descriptions of possible values diff --git a/Master/tlpkg/installer/install-menu-wizard.pl b/Master/tlpkg/installer/install-menu-wizard.pl deleted file mode 100644 index 90e62d3583b..00000000000 --- a/Master/tlpkg/installer/install-menu-wizard.pl +++ /dev/null @@ -1,622 +0,0 @@ -#!/usr/bin/env perl -# $Id$ -# Copyright 2009-2016 Norbert Preining -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -use strict; -$^W = 1; - -my $svnrev = '$Revision: 11925 $'; -$svnrev =~ m/: ([0-9]+) /; -$::menurevision = ($1 ? $1 : 'unknown'); - -require("TeXLive/trans.pl"); -load_translations(); - -require("$::installerdir/tlpkg/installer/texdirsel.pl"); - -# -# the following lists define which options are shown in the Option screen -# for unix and windows. On W32 with admin privileges both @w32 list options -# are shown -# the values are keys into the %vars array -my @unix_opts = qw/instopt_letter/; -my @w32_opts = qw/instopt_letter - tlpdbopt_desktop_integration - collection-texworks - /; -my @w32_admin_opts = qw/tlpdbopt_w32_multi_user/; - -my @opts_list = (); -if (win32()) { - push @opts_list, @w32_opts; - if (admin()) { - push @opts_list, @w32_admin_opts; - } -} else { - push @opts_list, @unix_opts; -} -my %opts_to_str = ( - "instopt_letter" => __("Default paper size"), - "tlpdbopt_desktop_integration" => __("Add menu shortcuts"), - "tlpdbopt_file_assocs" => __("Change file associations"), - "instopt_adjustpath" => __("Adjust PATH setting in registry"), - "tlpdbopt_w32_multi_user" => __("Installation for all users"), - "collection-texworks" => __("Install TeXworks front end"), -); -my %opts_choices = ( - "instopt_letter" => ["A4", "letter"], -); - - - -our %vars; -our $tlpdb; -our $texlive_release; -our @media_available; - -our $MENU_INSTALL = 0; -our $MENU_ABORT = 1; -our $MENU_QUIT = 2; -our $MENU_ALREADYDONE = 3; - - -my $return = $MENU_INSTALL; - -require Tk; -require Tk::BrowseEntry; -require Tk::Dialog; -require Tk::DialogBox; -require Tk::PNG; -#require Tk::ROText; -#require Tk::ProgressBar; -require Tk::Font; - -use utf8; -no utf8; - -# -# -my $tit; -my $can; -my $prv; -my $nxt; -my $img; -my $dest_display; -my $warning; -our $mw; -my $usedfont; -my $fmain; -my $fbuttons; -my $ftitle; -my $counter; -my $lineskip; - -$::init_remote_needed = 0; - -my $LEFT = 130; -my $RIGHT = 50; -my $TOP = 50; -my $BOTTOM = 50; -my $INF = 300; -my $MWIDTH = 730; -my $MHEIGHT = 480; -my $TITLEHEIGHT = 30; -my $BUTTONSHEIGHT = 50; -my $INNERWIDTH = ($MWIDTH - $LEFT - $RIGHT); -my $INNERHEIGHT = ($MHEIGHT - $TOP - $TITLEHEIGHT - $BOTTOM - $BUTTONSHEIGHT); - -# the main installer runs %{$::run_menu} -$::run_menu = \&run_menu_wizard; - -###################################################################### -# From here on only function definitions -# #################################################################### - -sub menu_abort { - $return = $MENU_ABORT; - $mw->destroy; -} - -################# WELCOME SCREEN ###################################### - -sub run_menu_wizard { - $mw = Tk::MainWindow->new(-width => $MWIDTH, -height => $MHEIGHT); - $mw->protocol('WM_DELETE_WINDOW' => \&menu_abort); - #setup_hooks_wizard(); - - my $img = $mw->Photo(-format => 'png', -file => "$::installerdir/tlpkg/installer/texlive.png"); - $mw->Label(-image => $img, -background => "#0078b8")->place(-x => 0, -y => 0); - - $ftitle = $mw->Frame(-height => $TITLEHEIGHT, -width => $INNERWIDTH); - $ftitle->update; - $ftitle->place(-x => $LEFT, -y => $TOP); - - $tit = $ftitle->Label(-text => __('TeX Live %s Installation', $TeXLive::TLConfig::ReleaseYear)); - - $usedfont= $tit->cget("-font"); - $lineskip = $usedfont->metrics("-linespace"); - - $tit->place(-x => 0, -y => 0); - - $counter = $ftitle->Label(-text => "1/4"); - $counter->place(-x => $INNERWIDTH, -y => 0, -anchor => "ne"); - - $fmain = $mw->Frame(-height => $INNERHEIGHT, -width => $INNERWIDTH); - #, -borderwidth => 1, -relief => "ridge"); - $fmain->place(-x => $LEFT, -y => ($TOP + $TITLEHEIGHT)); - - - $can = $mw->Button(-width => 10, -relief => "ridge", -text => __('Quit'), - -command => \&menu_abort); - $prv = $mw->Button(-width => 10, -relief => "ridge", -text => __('< Back')); - $nxt = $mw->Button(-width => 10, -relief => "ridge", -text => __('Next >')); - - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); - - my $rb = $MWIDTH - $RIGHT; - $nxt->place(-x => ($MWIDTH - $RIGHT) , - -y => ($MHEIGHT - $BOTTOM), -anchor => "se")->focus(); - - reset_start(); - - Tk::MainLoop(); - return($return); -} - -sub reset_start { - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "1/4"); - $prv->placeForget; - - my $inf = $fmain->Label( - -text => __("Welcome to the installation of TeX Live %s\nhttp://tug.org/texlive\n\nThis wizard will guide you through the installation.", $TeXLive::TLConfig::ReleaseYear) - . ( (win32()) ? "\n\n" . __("In case of trouble, try to disable your virus scanner during installation.") : "" ) - . "\n\n" - . __("For an advanced, customizable installation, please consult\nthe web pages or installation guide.") - . "\n" - . ( (win32()) - ? __("Or use install-tl-advanced.bat.") - : __("Or specify --gui expert to install-tl.") ), - -justify => "left"); - $inf->place(-x => 0, -y => 50); - - # by default, if local media is present, we don't show this option - # unless the command line option -select_repository is given - my $adjust_mirror = 0; - if ($#media_available == -1 || $::opt_select_repository) { - my $mirror_selector = $fmain->Checkbutton( - -text => __("Change default repository"), - -variable => \$adjust_mirror - ); - $mirror_selector->place(-x => 0, -y => 250); - } - - $nxt->configure(-text => __("Next >") , - -command => sub { - if ($adjust_mirror) { - ask_mirror(); - } else { - $::init_remote_needed = 1; - load_remote_screen(); - } - }); - $nxt->configure(-state => "normal"); - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); -} - -################## MIRROR SCREEN ################################ - -sub ask_mirror { - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "1-1/4"); - - my @mirror_list; - my @netlst; - my @loclst; - if ($#media_available >= 0) { - for my $l (@media_available) { - my ($a, $b) = split ('#', $l); - if ($a eq 'local_compressed' || $a eq 'local_uncompressed') { - push @loclst, " $b"; - } elsif ($a eq 'NET') { - #push @netlst, " cmd line repository: $b"; - push @netlst, " " . __("Command line repository") . ": $b"; - } else { - tlwarn("Unknown media $l\n"); - } - } - if ($#loclst >= 0) { - push @mirror_list, __("LOCAL REPOSITORIES"); - push @mirror_list, @loclst; - } - } - push @mirror_list, __("NETWORK REPOSITORIES"); - push @mirror_list, " " . __("Default remote repository") . ": http://mirror.ctan.org"; - push @mirror_list, @netlst; - push @mirror_list, TeXLive::TLUtils::create_mirror_list(); - - my $mirror_entry; - - $fmain->Label(-text => __("Select repository") . ":")->place( - -x => 0, -y => 0); - $fmain->Label(-text => __("Mirror:"))->place(-x => 0, -y => 50); - $fmain->BrowseEntry(-state => 'readonly', - -listheight => 12, - -listwidth => 400, - -width => 35, - -autolistwidth => 1, - -choices => \@mirror_list, - -browsecmd => - sub { - if ($mirror_entry !~ m/^ /) { - $mirror_entry = ""; - } elsif ($mirror_entry =~ m!(http|ftp)://!) { - $mirror_entry = TeXLive::TLUtils::extract_mirror_entry($mirror_entry); - } else { - $mirror_entry =~ s/^\s*//; - # $mirror_entry = TeXLive::TLUtils::extract_mirror_entry($mirror_entry); - } - }, - -variable => \$mirror_entry)->place(-x => 150, -y => 50); - - $prv->configure(-text => __('< Back'), -command => \&reset_start ); - $nxt->configure(-text => __('Next >'), - -command => - sub { $::init_remote_needed = 1; load_remote_screen($mirror_entry); }); - - my $rb = $MWIDTH - $RIGHT; - $rb -= $nxt->width; - $rb -= 30; - - $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); -} - -sub ask_mirror_hierarchical { - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "1-1/4"); - - our $mirrors; - require("installer/mirrors.pl"); - - my @continents = sort keys %$mirrors; - my @countries; - my @mirrors; - $fmain->Label(-text => "Select mirror for installation:")->place( - -x => 0, -y => 0); - my $continent = ""; - my $country = ""; - my $mirror = ""; - my $cbrowser; - my $mbrowser; - $fmain->Label(-text => __("Continent"))->place(-x => 0, -y => 50); - $fmain->BrowseEntry(-state => 'readonly', - -listheight => $#continents + 1, -choices => \@continents, - -variable => \$continent, - -browsecmd => - sub { - $cbrowser->delete(0,"end"); - @countries = sort keys %{$mirrors->{$continent}}; - for my $c (@countries) { - $cbrowser->insert("end", $c); - } - $mirror = ""; - $country = ""; - })->place(-x => 150, -y => 50); - $fmain->Label(-text => __("Countries"))->place(-x => 0, -y => 100); - $cbrowser = $fmain->BrowseEntry(-state => 'readonly', - -listheight => 5, -choices => \@countries, - -variable => \$country, - -browsecmd => - sub { - $mbrowser->delete(0,"end"); - @mirrors = sort keys %{$mirrors->{$continent}{$country}}; - for my $m (@mirrors) { - $mbrowser->insert("end", $m); - } - # always select the first mirror in the list - if ($#mirrors >= 0) { - $mirror = $mirrors[0]; - } else { - $mirror = ""; - } - })->place(-x => 150, -y => 100); - $fmain->Label(-text => __("Mirrors"))->place(-x => 0, -y => 150); - $mbrowser = $fmain->BrowseEntry(-state => 'readonly', - -listheight => 5, -choices => \@mirrors, - -variable => \$mirror,)->place(-x => 150, -y => 150); - - $prv->configure(-text => __('< Back'), -command => \&reset_start ); - $nxt->configure(-text => __('Next >'), - -command => - sub { - if (!defined($continent) || !defined($country) || !defined($mirror) || - $continent eq "" || $country eq "" || $mirror eq "") { - # do nothing, we just use the default mirror - $::init_remote_needed = 1; - load_remote_screen(); - } else { - my %m = %{$mirrors->{$continent}->{$country}->{$mirror}->{'protocols_path'}}; - my $mfull; - $mfull = "ftp://" . $m{'ftp'} if defined($m{'ftp'}); - $mfull = "http://" . $m{'http'} if defined($m{'http'}); - # remove terminal / if present - $mfull =~ s!/$!!; - $mfull .= "/" . $TeXLive::TLConfig::TeXLiveServerPath; - # set the selected location before going on! - $::init_remote_needed = 1; - load_remote_screen($mfull); - } - }); - - my $rb = $MWIDTH - $RIGHT; - $rb -= $nxt->width; - $rb -= 30; - - $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); -} - - -################## PATH SCREEN ################################ - -sub load_remote_screen { - my $remote_path = shift; - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "1-2/4"); - - if ($::init_remote_needed) { - my $labela = $fmain->Label(-text => __('Please wait while the repository database is loaded.'))->place(-x => 0, -y => 50); - my $labelb = $fmain->Label(-text => __('This will take some time!'))->place(-x => 0, -y => 150); - $prv->placeForget; - $nxt->placeForget; - $can->configure(-text => __('Cancel'), - -command => sub { $return = $MENU_ABORT; $mw->destroy; }); - $mw->update; - if (!only_load_remote($remote_path)) { - $labela->configure(-text => __('Could not load remote TeX Live Database:') . $remote_path); - $labelb->configure(-text => __('Please go back and select a different mirror.')); - $prv->configure(-text => __('< Back'), -command => \&reset_start ); - } elsif (!do_version_agree()) { - $labela->configure(-text => __('The TeX Live versions of the local installation -and the repository being accessed are not compatible: - local: %s -repository: %s', $TeXLive::TLConfig::ReleaseYear, $texlive_release)); - $labelb->configure(-text => __('Please go back and select a different mirror.')); - $prv->configure(-text => __('< Back'), -command => \&reset_start ); - } else { - final_remote_init($remote_path); - ask_path(); - } - } else { - ask_path(); - } - - my $rb = $MWIDTH - $RIGHT; - $rb -= $nxt->width; - $rb -= 30; - - $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); - $nxt->place(-x => ($MWIDTH - $RIGHT) , - -y => ($MHEIGHT - $BOTTOM), -anchor => "se")->focus(); -} - -sub ask_path { - for ($fmain->children) { - $_->destroy; - } - - $counter->configure(-text => "2/4"); - - $dest_display = native_slashify($vars{'TEXDIR'}); - - my $lab = $fmain->Label(-text => __('Destination folder:')); - my $val = $fmain->Label(-textvar => \$dest_display); - my $but = $fmain->Button(-text => __("Change"), -command => \&change_path, - -relief => "ridge", -width => 10); - - # texworks will be anyway installed in scheme-full - #my $but_tw = $fmain->Checkbutton(-text => __("Install TeXworks front end'), - # -variable => \$vars{"addon_editor"}); - - # - # disable the "Advanced Configuration" button switching to the - # perltk installer - # - #my $cb = $fmain->Button(-text => __("Advanced Configuration"), - # -relief => "ridge", - # -command => sub { $mw->destroy; - # require("installer/install-menu-perltk.pl"); - # setup_hooks_perltk(); - # $return = run_menu_perltk(); - # }); - - calc_depends(); - - - $fmain->Label(-text => __("The destination folder will contain the installation.\nIt is strongly recommended to keep the year as the last component."), - -justify => "left")->place(-x => 0, -y => 20); - - my $ytmp = 100; - $lab->place(-x => 0, -y => $ytmp, -anchor => "w"); - $ytmp += ($lineskip + 10); - $val->place(-x => 0, -y => $ytmp, -anchor => "w"); - - $but->place(-x => $INNERWIDTH, -y => $ytmp, -anchor => "e"); - - $warning = $fmain->Label(-foreground => "red"); - check_show_warning(); - $ytmp += ($lineskip + 10); - $warning->place(-x => 0, -y => $ytmp, -anchor => "w"); - - - #if (win32()) { - # $but_tw->place(-x => 0, -y => $ytmp + 60); - #} - - #$cb->place(-x => $INNERWIDTH, -y => $INNERHEIGHT, -anchor => "se"); - - $fmain->Label(-text => __('disk space required:') . " $vars{'total_size'} MB", - -justify => "left" - )->place(-x => 0, -y => $fmain->height, -anchor => "sw"); - - $prv->configure(-text => __('< Back'), -command => \&reset_start ); - $nxt->configure(-text => __('Next >'), -command => \&ask_options ); - - my $rb = $MWIDTH - $RIGHT; - $rb -= $nxt->width; - $rb -= 30; - - $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); -} - -sub check_show_warning { - if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) { - $warning->configure(-text => ""); - $nxt->configure(-state => "normal"); - } else { - $warning->configure(-text => __('(default not allowed or not writable - please change!)')); - $nxt->configure(-state => "disabled"); - } -} - -sub callback_change_texdir { - my ($val) = @_; - my $home = getenv('HOME'); - my $texdirnoslash; - if (win32()) { - $home = getenv('USERPROFILE'); - $home =~ s!\\!/!g; - } - $home ||= '~'; - $val =~ s!\\!/!g; - $vars{'TEXDIR'} = $val; - $vars{'TEXDIR'} =~ s/^~/$home/; - $vars{'TEXMFLOCAL'} =~ s/^~/$home/; - $vars{'TEXMFSYSVAR'} =~ s/^~/$home/; - $vars{'TEXMFSYSCONFIG'} =~ s/^~/$home/; - # only if we set TEXDIR we set the others in parallel - if ($vars{'TEXDIR'}=~/^(.*)\/$texlive_release$/) { - $vars{'TEXMFLOCAL'}="$1/texmf-local"; - $vars{'TEXMFSYSVAR'}="$1/$texlive_release/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$1/$texlive_release/texmf-config"; - } elsif ($vars{'TEXDIR'}=~/^(.*)$/) { - $texdirnoslash = $1; - $texdirnoslash =~ s!/$!!; - $vars{'TEXMFLOCAL'}="$texdirnoslash/texmf-local"; - $vars{'TEXMFSYSVAR'}="$texdirnoslash/texmf-var"; - $vars{'TEXMFSYSCONFIG'}="$texdirnoslash/texmf-config"; - } - #$dest = $vars{'TEXDIR'}; - $dest_display = native_slashify($vars{'TEXDIR'}); # useful as -textvar value in Labels - check_show_warning(); -} - -################## OPTIONS SCREEN ################################ - -sub ask_options { - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "3/4"); - - my $inf = $fmain->Label(-text => __("This screen allows you to configure some options"), -justify => "left"); - $inf->place(-x => 0, -y => 20); - - calc_depends(); - - my $ytmp = 60; - - for my $o (@opts_list) { - if (exists($opts_choices{$o})) { - my $fopt = $fmain->Frame()->place(-x => 0, -y => $ytmp); - $fopt->Label( - -text => $opts_to_str{$o} . ":\t" - )->pack(-side => 'left'); - for (my $i = 0; $i < @{$opts_choices{$o}}; $i++) { - $fopt->Radiobutton( - -text => __($opts_choices{$o}->[$i]), - -variable => \$vars{$o}, - -value => $i, - )->pack(-side => 'left'); - } - } else { - $fmain->Checkbutton(-text => $opts_to_str{$o}, - -variable => \$vars{$o})->place(-x => 0, -y => $ytmp); - } - $ytmp += 50; - } - - $prv->configure(-text => __('< Back'), -command => \&ask_path ); - $nxt->configure(-text => __('Next >'), -command => \&ask_go ); - - my $rb = $MWIDTH - $RIGHT; - $rb -= $nxt->width; - $rb -= 30; - - $prv->place(-x => $rb, -y => ($MHEIGHT - $BOTTOM), -anchor => "se"); -} - - -################## INSTALL SCREEN ############################# - -sub ask_go { - for ($fmain->children) { - $_->destroy; - } - $counter->configure(-text => "4/4"); - my $inf = $fmain->Label(-justify => "left", -text => __("We are ready to install TeX Live %s.\nThe following settings will be used.\nIf you want to change something please go back,\notherwise press the \"Install\" button.", $TeXLive::TLConfig::ReleaseYear)); - - - $inf->place(-x => 0, -y => 80); - - my $ytmp = 170; - - $fmain->Label(-justify => "left", - -text => __("Destination folder:") . "\t $dest_display")->place(-x => 0, -y => $ytmp); - $ytmp += 20; - - for my $o (@opts_list) { - my $text = $opts_to_str{$o} . ":\t"; - if (exists ($opts_choices{$o})) { - $text .= $opts_choices{$o}->[$vars{$o}]; - } else { - $text .= $vars{$o} ? __("Yes") : __("No"); - } - $fmain->Label(-justify => "left", - -text => $text)->place(-x => 0, -y => $ytmp); - $ytmp += 20; - } - - - - $nxt->configure(-text => __('Install'), - -command => sub { $return = $MENU_INSTALL; $mw->destroy; }); -# -command => \&wizard_installation_window); - $prv->configure(-text => __('< Back'), -command => \&ask_options); - $can->place(-x => $LEFT, -y => ($MHEIGHT - $BOTTOM), -anchor => "sw"); -} - -################### END OF MODULE RETURN 1 FOR REQUIRE ########### - -1; - -__END__ - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl index 14c4fa49a0c..a8b5c0415c1 100755 --- a/Master/tlpkg/installer/install-tl-gui.tcl +++ b/Master/tlpkg/installer/install-tl-gui.tcl @@ -150,52 +150,7 @@ proc dblog {s} { close $db } -proc maybe_print_welcome {} { - # if the last non-empty line was "All done", then installation is completed. - # otherwise, it was help output or an interrupted installation. - # we allow for spurious empty lines at the end of the backend output. - - set all_done 0 - for {set i [.log.tx count -lines 1.0 end]} {$i > 0} {incr i -1} { - set l [.log.tx get ${i}.0 ${i}.end] - if {$l ne ""} { - if {[string range $l 0 11] eq "Installed on"} { - set all_done 1 - } - break - } - } - if {!$all_done} return - # need TEXDIR and this_platform in case of profile install - if {! [info exists ::vars(this_platform)] || \ - ! [info exists ::vars(TEXDIR)]} { - if [regexp {^Installed on platform (.*) at (.*)$} $l m p r] { - set ::vars(this_platform) $p - set ::vars(TEXDIR) $r - } else { - set ::vars(this_platform) "PLATFORM" - set ::vars(TEXDIR) "ROOT" - } - } - - .log.tx configure -state normal - .log.tx tag configure center -justify center - .log.tx delete ${i}.0 end - .log.tx insert end "\n\n" - .log.tx insert end [__ "Welcome to TeX Live!"] center - .log.tx insert end "\n\n" - # tags appear to interfere with --/::msgcat::mc !?! - set s [__ "See %s/index.html for links to documentation.\nThe TeX Live web site (https://tug.org/texlive/) contains any updates and corrections. TeX Live is a joint project of the TeX user groups around the world; please consider supporting it by joining the group best for you. The list of groups is available on the web at https://tug.org/usergroups.html." $::vars(TEXDIR)] - .log.tx insert end $s center - if {$::tcl_platform(platform) ne "windows"} { - .log.tx insert end "\n\n" - set s [__ "Add %s/texmf-dist/doc/man to MANPATH.\nAdd %s/texmf-dist/doc/info to INFOPATH.\nMost importantly, add %s/bin/%s\nto your PATH for current and future sessions." $::vars(TEXDIR) $::vars(TEXDIR) $::vars(TEXDIR) $::vars(this_platform)] - .log.tx insert end $s center - } - .log.tx insert end "\n" - .log.tx yview moveto 1 - if {$::tcl_platform(os) ne "Darwin"} {.log.tx configure -state disabled} -} +# welcome message now provided by install-tl # regular read_line proc read_line {} { @@ -256,7 +211,6 @@ proc read_line_cb {} { # This closes stdin of the child .close state !disabled if [winfo exists .abort] {.abort state disabled} - maybe_print_welcome } elseif {$len >= 0} { # regular output .log.tx configure -state normal diff --git a/Master/tlpkg/installer/texdirsel.pl b/Master/tlpkg/installer/texdirsel.pl deleted file mode 100755 index dffced3beaa..00000000000 --- a/Master/tlpkg/installer/texdirsel.pl +++ /dev/null @@ -1,277 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use warnings; -$^W = 1; - -require Cwd; -require File::Spec; - -our $texlive_release; -our %vars; -our $mw; - -my $sep; -if (win32()) { - $sep = "\\"; -} else { - $sep = "/"; -} - -sub change_path { - - ### GUI SETUP ### - - my $sw; - $sw->destroy if Tk::Exists($sw); - $sw = $mw->Toplevel(-title => "Changing TEXDIR"); - $sw->transient($mw); - $sw->withdraw; - $sw->grab(); - - # define a larger font - my $lfont = $sw->fontCreate(); - $sw->fontConfigure( - $lfont, -size => 1.2 * $mw->fontConfigure($lfont, -size)); - - my $fr0 = $sw->Frame(-padx => 10, -pady => 5)->pack; - $sw->Label(-text => __("Installation directory").": ", -font => $lfont) - ->pack(-in => $fr0, -side => 'left'); - my $path_l = $sw->Label(-font => $lfont) - ->pack(-in => $fr0, -side => 'left'); - - my $fr = $sw->Frame->pack; - my $prefix_l = $sw->Label(-justify => 'right', -padx => 5) - ->grid(-in => $fr, -column => 0, -row => 0, -sticky => 'e'); - $sw->Label(-text => $sep) - ->grid(-in => $fr, -column => 1, -row => 0); - my $name_l = $sw->Label(-justify => 'center', -padx => 5) - ->grid(-in => $fr, -column => 2, -row => 0); - $sw->Label(-text => $sep) - ->grid(-in => $fr, -column => 3, -row => 0); - my $rel_l = $sw->Label(-justify => 'left', -padx => 5) - ->grid(-in => $fr, -column => 4, -row => 0, -sticky => 'w'); - - my $prefix_b = $sw->Button( - -text => __("Change". '...'), -padx => 1, -pady => 3, -bd => 1) - ->grid(-in => $fr, -column => 0, -row => 1, -sticky => 'ew'); - my $name_b = $sw->Button( - -text => __("Change"), -padx => 1, -pady => 3, -bd => 1) - ->grid(-in => $fr, -column => 2, -row => 1, -sticky => 'ew', -padx => 2); - my $rel_b = $sw->Button( - -text => __("Toggle"), -padx => 1, -pady => 3, -bd => 1) - ->grid(-in => $fr, -column => 4, -row => 1, -sticky => 'ew'); - - # warning about year component - my $warn_yr_l = $sw->Label(-anchor => 'e', -foreground => 'red') - ->pack(-fill =>'x', -expand => 1); - - # ok and cancel buttons - my $frb = $sw->Frame->pack(-fill => 'x', -expand => 1); - my $ok_b = $sw->Button( - -text => __("Ok"), - -command => sub { - callback_change_texdir(forward_slashify($path_l->cget(-text))); - $sw->destroy; - })->pack(-in => $frb, -side => 'right'); - my $q = $sw->Button(-text => __("Cancel"), -command => sub {$sw->destroy;}) - ->pack(-in => $frb, -side => 'right'); - - if (win32()) { - $frb->Label( - -text => - __("Localized directory names will be replaced by their real names")) - ->pack(-side => 'left'); - } - - # array of widgets needed by callbacks - my @wg = ($path_l, $prefix_l, $name_l, $rel_l, $ok_b, $warn_yr_l); - - # callbacks which use @wg - $prefix_b->configure(-command => [\&browse_path, $sw, @wg]); - $name_b->configure(-command => [\&edit_name, $sw, @wg]); - $rel_b->configure(-command => [\&toggle_rel, @wg]); - - # bindings - $sw->bind('<Return>' => [ $ok_b, 'Invoke']); - $sw->bind('<Escape>' => [ $q, 'Invoke']); - - ### END GUI SETUP ### - - my $val = $vars{'TEXDIR'}; - $val = native_slashify($val); - $path_l->configure(-text => $val); - - # release subdirectory at the end? - my $rel_pat = "[\\\\/]".$texlive_release."[\\\\/]?\$"; - - # calculate initial values based on existing $val (copied from TEXDIR) - my $initdir = File::Spec->rel2abs($val); - my $rel = ""; - my $name = ""; - # check for release subdirectory at the end and remove from initdir - if ($initdir =~ $rel_pat) { - $initdir =~ s!$rel_pat!!; - $rel = $texlive_release; - $rel_l->configure(-text => $texlive_release); - } - # now assign remaining final path component to name_l - if ($initdir =~ /[\\\/]([^\\\/]+)[\\\/]?$/) { - $name_l->configure(-text => $1); - $initdir =~ s/[\\\/][^\\\/]+[\\\/]?$//; - } - - # backtrack remaining initdir to something that exists - # and assign it to prefix - while (! -d $initdir) { - my $initprev = $initdir; - $initdir =~ s/[\\\/][^\\\/]+[\\\/]?$//; - last if ($initdir eq $initprev); - } - if ($initdir eq "" or (win32() and $initdir =~ /:$/)) { - $initdir = $initdir . (win32() ? "\\" : "/"); - } - $prefix_l->configure(-text => $initdir); - # display complete path in $path_l - update_full_path( @wg ); - $sw->deiconify(); - $sw->raise($mw); - $sw->grab(); -} # change_path - -sub update_full_path { - my $path_l = shift; - my $prefix_l = shift; - my $name_l = shift; - my $rel_l = shift; - my $ok_b = shift; - my $warn_yr_l = shift; - - my $prefix = $prefix_l->cget(-text); - if ($prefix eq "" or (win32() and $prefix =~ /:$/)) { - $prefix_l->insert('end', $sep); - $prefix .= $sep; - } - my $name = $name_l->cget(-text); - if ($name =~ m![\\/]!) { - $name =~ s![\\/]!!g; - $name_l->delete(0, 'end'); - $name_l->insert(0, $name); - } - $path_l->configure( - -text => File::Spec->catdir($prefix, $name, $rel_l->cget(-text))); - if (-d $prefix) { - $ok_b->configure(-state => 'normal'); - } else { - $ok_b->configure(-state => 'disabled'); - } - # check for release component - if ($rel_l->cget(-text) ne '') { - $warn_yr_l->configure(-text => ''); - } else { - $warn_yr_l->configure( - -text => __('Release year component highly recommended!')); - } - return; -} # update_full_path - -sub toggle_rel { - my $path_l = shift; - my $prefix_l = shift; - my $name_l = shift; - my $rel_l = shift; - my $ok_b = shift; - my $warn_yr_l = shift; - - if ($rel_l->cget(-text) eq '') { - $rel_l->configure(-text => $texlive_release); - } else { - $rel_l->configure(-text => ''); - } - update_full_path($path_l, $prefix_l, $name_l, $rel_l, $ok_b, $warn_yr_l); -} # toggle_rel - -sub edit_name { - my $sw = shift; # parent window - my $path_l = shift; - my $prefix_l = shift; - my $name_l = shift; - my $rel_l = shift; - my $ok_b = shift; - my $warn_yr_l = shift; - my $ednm; - $ednm->destroy if Tk::Exists($ednm); - $ednm = $sw->Toplevel(-title => __("Changing directory name")); - $ednm->transient($sw); - $ednm->withdraw(); - - $ednm->Label(-text => __("Change name (slashes not allowed)")) - ->pack(-padx => 5, -pady => 5); - my $nm_e = $ednm->Entry(-width => 20)->pack(-pady => 5); - $nm_e->insert(0, $name_l->cget(-text)); - my $fr = $ednm->Frame->pack(-fill => 'x', -expand => 1); - my $ok = $ednm->Button( - -text => __("OK"), - -command => sub { - my $nm = $nm_e->get; - if ($nm !~ m![\\/]!) { - $name_l->configure(-text => $nm); - update_full_path( - $path_l, $prefix_l, $name_l, $rel_l, $ok_b, $warn_yr_l); - $ednm->destroy(); - } else { - $ednm->messageBox( - -icon => 'error', - -type => 'Ok', - -message => __("Illegal name")); - } - })->pack(-in => $fr, -side => 'right', -pady => 5, -padx => 5); - my $cancel = $ednm->Button( - -text => __("Cancel"), - -command => sub { $ednm->destroy(); }) - ->pack(-in => $fr, -side => 'right'); - $ednm->deiconify(); - $ednm->raise($sw); - $ednm->grab(); -} # edit_name - -sub browse_path { - my $mw = shift; - my $path_l = shift; - my $prefix_l = shift; - my $name_l = shift; - my $rel_l = shift; - my $ok_b = shift; - my $warn_yr_l = shift; - - my $retval = $prefix_l->cget(-text); - my $use_native = 0; # choice of directory browser - if ($^O =~ /^MSWin/i) { - $use_native = 1; - } else { - eval { require Tk::DirSelect; }; - if ($@) { - eval { require installer::DirSelect; }; - if ($@) { - $use_native = 1; - } - } - } - if ($use_native) { - $retval = $mw->chooseDirectory( - -initialdir => $retval, - -parent => $mw, - -title => __("Select prefix destination directory"), - ); - } else { - my $fsdia = $mw->DirSelect( - -title => __("Select prefix destination directory")); - $retval = $fsdia->Show($retval, -popover => $mw); - $fsdia->destroy; - } - if (defined $retval and $retval ne "") { - $prefix_l->configure(-text => File::Spec->rel2abs($retval)); - update_full_path($path_l, $prefix_l, $name_l, $rel_l, $ok_b, $warn_yr_l); - } - return; -} # browse_path diff --git a/Master/tlpkg/installer/tracked-install.pl b/Master/tlpkg/installer/tracked-install.pl deleted file mode 100644 index f16e15280bb..00000000000 --- a/Master/tlpkg/installer/tracked-install.pl +++ /dev/null @@ -1,139 +0,0 @@ -#!/usr/bin/env perl -# $Id$ -# -# Copyright 2008-2017 Norbert Preining -# Copyright 2008 Reinhard Kotucha -# This file is licensed under the GNU General Public License version 2 -# or any later version. - -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", -wrap => "word", -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) { - tlwarn ("$t\n"); - } - } - if ($::env_warns) { - tlwarn($::env_warns); - } - $::progressw->tagConfigure('centered', -justify => 'center'); - # basic welcome message - foreach my $t (@::welcome_arr) { - info("$t\n"); - } - $::progressw->insert("end", "\n"); - - do_cleanup(); - - # 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)); - } -} |