TeX Live: texmf-dist/scripts/texlive/tlmgrgui.pl

"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20231204/texmf-dist/scripts/texlive/tlmgrgui.pl" (19 Feb 2023, 91330 Bytes) of package /linux/misc/install-tl-unx.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

A hint: This file contains one or more very long lines, so maybe it is better readable using the pure text view mode that shows the contents as wrapped lines within the browser window.

1 #!/usr/bin/env perl 2 # $Id: tlmgrgui.pl 65932 2023-02-19 20:49:48Z siepo $ 3 # 4 # Copyright 2009-2019 Norbert Preining 5 # This file is licensed under the GNU General Public License version 2 6 # or any later version. 7 # 8 # GUI for tlmgr 9 # version 2, completely rewritten GUI 10 # 11 # TODO: implement path adjustment also for Windows 12 13 $^W = 1; 14 use strict; 15 16 my $guisvnrev = '$Revision: 65932 $'; 17 my $guidatrev = '$Date: 2023-02-19 21:49:48 +0100 (Sun, 19 Feb 2023) $'; 18 my $tlmgrguirevision; 19 if ($guisvnrev =~ m/: ([0-9]+) /) { 20 $tlmgrguirevision = $1; 21 } else { 22 $tlmgrguirevision = "unknown"; 23 } 24 $guidatrev =~ s/^.*Date: //; 25 $guidatrev =~ s/ \(.*$//; 26 $tlmgrguirevision .= " ($guidatrev)"; 27 28 use Tk; 29 use Tk::Dialog; 30 use Tk::Adjuster; 31 use Tk::BrowseEntry; 32 use Tk::ROText; 33 use Tk::HList; 34 use Tk::ItemStyle; 35 use File::Glob; 36 37 use Pod::Text; 38 39 #use Devel::Leak; 40 41 use TeXLive::TLUtils qw(setup_programs platform_desc wndws debug); 42 use TeXLive::TLConfig; 43 44 # 45 # GUI mode 46 # 47 our %config; 48 my $mode_expert = $config{"gui-expertmode"}; 49 50 # 51 # stuff defined in tlmgr.pl that needs to be our-ed 52 our $Master; 53 our $remotetlpdb; 54 our $localtlpdb; 55 our $location; 56 our %opts; 57 our @update_function_list; 58 59 my $tlpdb_location; 60 my %tlpdb_repos; 61 my @tlpdb_tags; 62 my $cmdline_location; 63 my @critical_updates = (); 64 65 my $single_repo_mode = 1; 66 my %repos; 67 my @tags; 68 69 my $location_button; # uggg, change from far away ... 70 71 # 72 # shortcuts for padding, expand/fill, and pack sides, anchors 73 my @p_ii = qw/-padx 2m -pady 2m/; 74 my @p_iii= qw/-padx 3m -pady 3m/; 75 my @x_x = qw/-expand 1 -fill x/; 76 my @x_y = qw/-expand 1 -fill y/; 77 my @x_xy= qw/-expand 1 -fill both/; 78 my @left = qw/-side left/; 79 my @right= qw/-side right/; 80 my @bot = qw/-side bottom/; 81 my @a_w = qw/-anchor w/; 82 my @a_c = qw/-anchor c/; 83 my @htype = qw/-relief ridge/; 84 85 # 86 # the list of packages as shown by TixGrid 87 # 88 my %Packages; 89 my $mw; 90 my $tlmgrrev; 91 my $menu; 92 my $menu_file; 93 my $menu_options; 94 my $menu_actions; 95 my $menu_help; 96 97 # default color for background 98 my $bgcolor; 99 100 # 101 # GUI elements 102 # 103 my $g; # the scrolled list of packages 104 my $lighttext; 105 my $darktext; 106 my $match_entry; 107 my $loaded_text; 108 my $loaded_text_button; 109 my $default_repo; 110 my $update_all_button; 111 112 my %settings_label; 113 114 # 115 # communication between filters and the rest 116 my $status_all = 0; 117 my $status_only_installed = 1; 118 my $status_only_not_installed = 2; 119 my $status_only_updated = 3; 120 my $status_value = 0; 121 my $show_packages = 1; 122 my $show_collections = 1; 123 my $show_schemes = 1; 124 my $match_descriptions = 1; 125 my $match_filenames = 1; 126 my $match_text = ""; 127 my $selection_value = 0; 128 129 # locale support moved to tlmgr.pl 130 131 my @archsavail; 132 my @archsinstalled; 133 my %archs; 134 my $currentarch; 135 136 my @fileassocdesc; 137 $fileassocdesc[0] = __("None"); 138 $fileassocdesc[1] = __("Only new"); 139 $fileassocdesc[2] = __("All"); 140 my %defaults; 141 my %changeddefaults; 142 143 my %papers; 144 my %currentpaper; 145 my %changedpaper; 146 my %init_paper_subs; 147 $init_paper_subs{"xdvi"} = \&init_paper_xdvi; 148 $init_paper_subs{"pdftex"} = \&init_paper_pdftex; 149 $init_paper_subs{"dvips"} = \&init_paper_dvips; 150 $init_paper_subs{"context"} = \&init_paper_context; 151 $init_paper_subs{"dvipdfmx"} = \&init_paper_dvipdfmx; 152 $init_paper_subs{"psutils"} = \&init_paper_psutils; 153 154 155 guimain(); 156 157 ############# MAIN FUNCTION ########################## 158 159 sub guimain { 160 build_initial_gui(); 161 init_hooks(); 162 163 info(__("Loading local TeX Live database") . 164 "\n ($::maintree/$InfraLocation/$DatabaseName)\n" . 165 __("This may take some time, please be patient ...") . 166 "\n"); 167 168 # call the init function from tlmgr.pl 169 # with 0 as argument, so that it does not call die on errors. 170 init_local_db(0); 171 # before this code was used, which is a duplication, and in addition 172 # it does not handle auto-loading of $location 173 #$localtlmedia = TeXLive::TLMedia->new ( $Master ); 174 #die("cannot setup TLMedia in $Master") unless (defined($localtlmedia)); 175 #$localtlpdb = $localtlmedia->tlpdb; 176 #die("cannot find tlpdb!") unless (defined($localtlpdb)); 177 178 # 179 # init_local_db sets up $location to the winning one: 180 # cmd line > tlpdb 181 # save the two possible location for the menu 182 $tlpdb_location = $localtlpdb->option("location"); 183 %tlpdb_repos = repository_to_array($tlpdb_location); 184 @tlpdb_tags = keys %tlpdb_repos; 185 if (defined($opts{"location"})) { 186 $cmdline_location = $opts{"location"}; 187 } 188 189 190 push @update_function_list, \&check_location_on_ctan; 191 push @update_function_list, \&init_install_media; 192 193 # already done by init_local_db above 194 # setup_programs("$Master/tlpkg/installer", $localtlmedia->platform); 195 196 # 197 # check that we can actually save the database 198 # 199 if (check_on_writable()) { 200 $::we_can_save = 1; 201 } else { 202 $::we_can_save = 0; 203 } 204 $::action_button_state = ($::we_can_save ? "normal" : "disabled"); 205 206 $tlmgrrev = give_version(); 207 chomp($tlmgrrev); 208 209 setup_menu_system(); 210 do_rest_of_gui(); 211 $bgcolor = $loaded_text->cget('-background'); 212 213 setup_list(); 214 update_grid(); 215 216 217 if ($opts{"load"}) { 218 setup_location($tlpdb_location); 219 } 220 221 222 info(__("... done loading") . ".\n"); 223 $mw->deiconify; 224 225 226 if (!$::we_can_save) { 227 my $no_write_warn = $mw->Dialog(-title => __("Warning"), 228 -text => __("You don't have permissions to change the installation in any way;\nspecifically, the directory %s is not writable.\nPlease run this program as administrator, or contact your local admin.\n\nMost buttons will be disabled.", "$Master/tlpkg/"), 229 -buttons => [ __("Ok") ])->Show(); 230 } 231 232 Tk::MainLoop(); 233 } 234 235 236 ############## GUI ######################## 237 238 sub build_initial_gui { 239 # processed @::SAVEDARGV to replace 240 # --font='foobar' 241 # with 242 # --font 'foobar' 243 # as required by Tk::CmdLine. 244 my @a; 245 for my $c (@::SAVEDARGV) { 246 if ($c =~ m/^--?(font|background|class|display|screen|foreground|geometry|name|title|xrm)=(.*)$/) { 247 push @a, "--$1", $2; 248 } else { 249 push @a, $c; 250 } 251 } 252 Tk::CmdLine::SetArguments(@a); 253 $mw = MainWindow->new; 254 $mw->title("TeX Live Manager $TeXLive::TLConfig::ReleaseYear"); 255 $mw->withdraw; 256 257 # 258 # default layout definitions 259 # 260 # priority 20 = widgetDefault 261 # see Mastering Perl/Tk, 16.2. Using the Option Database 262 $mw->optionAdd("*Button.Relief", "ridge", 20); 263 # 264 # does not work, makes all buttons exactely 10, which is not a good idea 265 # I would like to have something like MinWidth 10... 266 #$mw->optionAdd("*Button.Width", "10", 20); 267 268 # create a progress bar window 269 $::progressw = $mw->Scrolled("ROText", -scrollbars => "e", -height => 4); 270 $::progressw->pack(-fill => "x", @bot); 271 } 272 273 sub do_rest_of_gui { 274 # This needs to come first as we call update_grid rather early 275 #my $list_frame = $mw->Labelframe(-text => "Packages"); 276 my $gf = $mw->Frame; 277 278 #my $list_frame = $mw->Frame; 279 my $list_frame = $gf->Frame; 280 $g = $list_frame->Scrolled('HList', -scrollbars => "se", -bd => 0, 281 -command => \&show_extended_info, # does not work, double click! 282 -columns => 5, -header => 1, 283 -borderwidth => 1, #-padx => 0, -pady => 0, 284 -separator => "/", 285 -selectmode => "none"); 286 287 my $button_frame = $mw->Labelframe(-text => __("Repository")); 288 $loaded_text = $button_frame->Label(-text => __("Loaded:") . " " . __("none")); 289 $loaded_text->pack(@left, @p_ii); 290 291 $loaded_text_button = $button_frame->Button(-text => __("Load default"), 292 -command => sub { setup_location($tlpdb_location); }); 293 $loaded_text_button->pack( @left, @p_ii); 294 295 my %repos = repository_to_array($tlpdb_location); 296 my @tags = keys %repos; 297 my $foo; 298 if ($#tags > 0) { 299 $foo = __("multiple repositories"); 300 } else { 301 $foo = $tlpdb_location; 302 } 303 304 $default_repo = $button_frame->Label(-text => __("Default:") . " " . $foo ); 305 $default_repo->pack(@left, @p_ii); 306 307 #$button_frame->pack(-expand => 1, -fill => 'x', @p_ii); 308 309 #my $top_frame = $mw->Labelframe(-text => __("Display configuration")); 310 my $top_frame = $gf->Labelframe(-text => __("Display configuration")); 311 312 my $filter_frame = $top_frame->Frame(); 313 $filter_frame->pack(-expand => 1, -fill => 'both'); 314 315 my $filter_status = $filter_frame->Labelframe(-text => __("Status")); 316 $filter_status->pack(@left, @x_y, @p_ii); 317 318 $filter_status->Radiobutton(-text => __("all"), -command => \&update_grid, 319 -variable => \$status_value, -value => $status_all)->pack(@a_w); 320 $filter_status->Radiobutton(-text => __("installed"), -command => \&update_grid, 321 -variable => \$status_value, -value => $status_only_installed)->pack(@a_w); 322 $filter_status->Radiobutton(-text => __("not installed"), -command => \&update_grid, 323 -variable => \$status_value, -value => $status_only_not_installed)->pack(@a_w); 324 $filter_status->Radiobutton(-text => __("updates"), -command => \&update_grid, 325 -variable => \$status_value, -value => $status_only_updated)->pack(@a_w); 326 327 my $filter_category = $filter_frame->Labelframe(-text => __("Category")); 328 if ($mode_expert) { $filter_category->pack(@left, @x_y, @p_ii); } 329 $filter_category->Checkbutton(-text => __("packages"), -command => \&update_grid, 330 -variable => \$show_packages)->pack(@a_w); 331 $filter_category->Checkbutton(-text => __("collections"), -command => \&update_grid, 332 -variable => \$show_collections)->pack(@a_w); 333 $filter_category->Checkbutton(-text => __("schemes"), -command => \&update_grid, 334 -variable => \$show_schemes)->pack(@a_w); 335 336 my $filter_match = $filter_frame->Labelframe(-text => __("Match")); 337 $filter_match->pack(@left, @x_y, @p_ii); 338 $match_entry = 339 $filter_match->Entry(-width => 15, -validate => 'key', 340 )->pack(@a_w, -padx => '2m', @x_x); 341 $filter_match->Checkbutton(-text => __("descriptions"), 342 -command => \&update_grid, 343 -variable => \$match_descriptions)->pack(@a_w); 344 $filter_match->Checkbutton(-text => __("filenames"), 345 -command => \&update_grid, 346 -variable => \$match_filenames)->pack(@a_w); 347 348 $match_entry->configure(-validate => 'key', 349 -validatecommand => sub { 350 my ($new_val, undef, $old_val) = @_; 351 # if (!$new_val) { 352 # $match_descriptions = 0; 353 # $match_filenames = 0; 354 # } else { 355 # # if something is already in the search field don't change selection 356 # if (!$old_val) { 357 # $match_descriptions = 1; 358 # $match_filenames = 1; 359 # } 360 # } 361 my $new_match_text = ( length($new_val) >= 3 ? $new_val : "" ); 362 if ($new_match_text ne $match_text) { 363 $match_text = $new_match_text; 364 update_grid(); 365 } 366 return 1; }); 367 368 my $filter_selection = $filter_frame->Labelframe(-text => __("Selection")); 369 if ($mode_expert) { $filter_selection->pack(@left, @x_y, @p_ii); } 370 $filter_selection->Radiobutton(-text => __("all"), -command => \&update_grid, 371 -variable => \$selection_value, -value => 0)->pack(@a_w); 372 $filter_selection->Radiobutton(-text => __("selected"), 373 -command => \&update_grid, -variable => \$selection_value, -value => 1) 374 ->pack(@a_w); 375 $filter_selection->Radiobutton(-text => __("not selected"), 376 -command => \&update_grid, -variable => \$selection_value, -value => 2) 377 ->pack(@a_w); 378 379 380 my $filter_button = $filter_frame->Frame; 381 $filter_button->pack(@left, @x_y, @p_ii); 382 if ($mode_expert) { 383 $filter_button->Button(-text => __("Select all"), 384 -command => [ \&update_grid, 1 ])->pack(@x_x, @a_c); 385 $filter_button->Button(-text => __("Select none"), 386 -command => [ \&update_grid, 0 ])->pack(@x_x, @a_c); 387 } 388 389 $filter_button->Button(-text => __("Reset filters"), 390 -command => sub { $status_value = $status_all; 391 $show_packages = 1; $show_collections = 1; 392 $show_schemes = 1; 393 $selection_value = 0; 394 $match_descriptions = 1; 395 $match_filenames = 1; 396 update_grid(); 397 })->pack(@x_x, @a_c); 398 399 ########## Packages ####################### 400 $g->pack(qw/-expand 1 -fill both -padx 3 -pady 3/); 401 $g->focus; 402 403 $lighttext = $g->ItemStyle('text', -background => 'gray90', 404 -selectbackground => 'gray90', -selectforeground => 'blue'); 405 $darktext = $g->ItemStyle('text', -background => 'gray70', 406 -selectbackground => 'gray70', -selectforeground => 'blue'); 407 408 409 $g->headerCreate(0, @htype, -itemtype => 'text', -text => ""); 410 $g->headerCreate(1, @htype, -itemtype => 'text', -text => __("Package name")); 411 $g->headerCreate(2, @htype, -itemtype => 'text', -text => __("Local rev. (ver.)")); 412 $g->headerCreate(3, @htype, -itemtype => 'text', -text => __("Remote rev. (ver.)")); 413 $g->headerCreate(4, @htype, -itemtype => 'text', -text => __("Short description")); 414 415 $g->columnWidth(0, 40); 416 $g->columnWidth(2, -char => 20); 417 $g->columnWidth(3, -char => 20); 418 419 my $bot_frame = $gf->Frame; 420 #my $bot_frame = $mw->Frame; 421 422 my $actions_frame = $bot_frame->Frame; 423 $actions_frame->pack(); 424 425 my $with_all_frame = $actions_frame->Frame; 426 $with_all_frame->pack(@left, -padx => '5m'); 427 $update_all_button = 428 $with_all_frame->Button(-text => __('Update all installed'), 429 -state => $::action_button_state, 430 -command => sub { update_all_packages(); } 431 )->pack(@p_ii); 432 $with_all_frame->Checkbutton(-text => __("Reinstall previously removed packages"), 433 -variable => \$opts{"reinstall-forcibly-removed"})->pack(); 434 435 436 my $with_sel_frame = $actions_frame->Frame; 437 $with_sel_frame->pack(@left, -padx => '5m'); 438 439 440 # 441 # disable the with filter applied or not applied, it is too complicated, or? 442 # 443 444 if ($mode_expert) { 445 $with_sel_frame->Button(-text => __('Update'), 446 -state => $::action_button_state, 447 -command => sub { update_selected_packages(); } 448 )->pack(@left, @p_ii); 449 } 450 $with_sel_frame->Button(-text => __('Install'), 451 -state => $::action_button_state, 452 -command => sub { install_selected_packages(); } 453 )->pack(@left, @p_ii); 454 $with_sel_frame->Button(-text => __('Remove'), 455 -state => $::action_button_state, 456 -command => sub { remove_selected_packages(); } 457 )->pack(@left, @p_ii); 458 if ($mode_expert) { 459 $with_sel_frame->Button(-text => __('Backup'), 460 -state => $::action_button_state, 461 -command => sub { backup_selected_packages(); } 462 )->pack(@left, @p_ii); 463 } 464 465 $button_frame->pack(-expand => 0, -fill => 'x', @p_ii); 466 $top_frame->pack(-fill => 'x', -padx => '2m'); 467 $bot_frame->pack(-fill => 'x', @p_ii, -side => 'bottom'); 468 $list_frame->pack(@x_xy, @p_ii); 469 470 $mw->Adjuster(-widget => $::progressw, -side => 'bottom') 471 ->pack(-side => 'bottom', -fill => 'x'); 472 473 $gf->pack(-side => 'top', -fill => 'both', -expand => 1); 474 475 } 476 477 ########### LOGGING ETC FUNCTIONS ############# 478 479 sub update_status_box { 480 update_status(join(" ", @_)); 481 $mw->update; 482 } 483 484 sub init_hooks { 485 push @::info_hook, \&update_status_box; 486 push @::warn_hook, \&update_status_box; 487 push @::debug_hook, \&update_status_box; 488 push @::ddebug_hook, \&update_status_box; 489 push @::dddebug_hook, \&update_status_box; 490 } 491 492 sub update_status { 493 my ($p) = @_; 494 $::progressw->insert("end", "$p"); 495 $::progressw->see("end"); 496 } 497 498 ############# GUI CALLBACKS ################## 499 500 sub setup_menu_system { 501 $menu = $mw->Menu(); 502 $menu_file = $menu->Menu(); 503 $menu_options = $menu->Menu(); 504 $menu_actions = $menu->Menu(); 505 $menu_help = $menu->Menu(); 506 $menu->add('cascade', -label => "tlmgr", -menu => $menu_file); 507 $menu->add('cascade', -label => __("Options"), -menu => $menu_options); 508 if ($mode_expert) { 509 $menu->add('cascade', -label => __("Actions"), -menu => $menu_actions); 510 } 511 # on win32 people expect to have the Help button on the right side 512 if (wndws()) { $menu->add('separator'); } 513 $menu->add('cascade', -label => __("Help"), -menu => $menu_help); 514 515 # 516 # FILE MENU 517 # 518 my %foo = repository_to_array($tlpdb_location); 519 my @bar = keys %foo; 520 my $tlpdb_location_string = $tlpdb_location; 521 if ($#bar > 0) { 522 $tlpdb_location_string = __("multiple repositories"); 523 } 524 $menu_file->add('command', 525 -label => __("Load default (from tlpdb) repository:") . " $tlpdb_location_string", 526 -command => sub { setup_location($tlpdb_location); }); 527 if (defined($cmdline_location)) { 528 $menu_file->add('command', -label => __("Load cmd line repository:") . " $cmdline_location", 529 -command => sub { setup_location($cmdline_location); }); 530 } 531 $menu_file->add('command', -label => __("Load standard net repository:") . " $TeXLiveURL", 532 -command => sub { setup_location($TeXLiveURL); }); 533 if ($mode_expert) { 534 $menu_file->add('command', -label => __("Load other repository ..."), 535 -command => \&cb_edit_location); 536 } 537 $menu_file->add('separator'); 538 $menu_file->add('command', -label => __("Quit"), 539 -command => sub { $mw->destroy; exit(0); }); 540 541 # 542 # OPTIONS MENU 543 # 544 $menu_options->add('command', -label => __("General ..."), 545 -command => sub { do_general_settings(); }); 546 $menu_options->add('command', -label => __("Paper ..."), 547 -command => sub { do_paper_settings(); }); 548 if (!wndws() && $mode_expert) { 549 $menu_options->add('command', -label => __("Platforms ..."), 550 -command => sub { do_arch_settings(); }); 551 } 552 if ($mode_expert) { 553 $menu_options->add('command', -label => __("GUI language ..."), 554 -command => sub { do_gui_language_setting(); }); 555 } 556 $menu_options->add('separator'); 557 $menu_options->add('checkbutton', -label => __("Expert options"), 558 -variable => \$mode_expert, 559 -command => sub { do_and_warn_gui_mode_settings(); }); 560 if ($mode_expert) { 561 $menu_options->add('checkbutton', -label => __("Enable debugging output"), 562 -onvalue => ($::opt_verbosity == 0 ? 1 : $::opt_verbosity), 563 -variable => \$::opt_verbosity); 564 $menu_options->add('checkbutton', 565 -label => __("Disable auto-install of new packages"), 566 -variable => \$opts{"no-auto-install"}); 567 $menu_options->add('checkbutton', 568 -label => __("Disable auto-removal of server-deleted packages"), 569 -variable => \$opts{"no-auto-remove"}); 570 } 571 572 # 573 # Actions menu 574 # 575 $menu_actions->add('command', -label => __("Update filename database"), 576 -state => $::action_button_state, 577 -command => sub { 578 $mw->Busy(-recurse => 1); 579 info("Running mktexlsr, this may take some time ...\n"); 580 info(`mktexlsr 2>&1`); 581 $mw->Unbusy; 582 }); 583 $menu_actions->add('command', -label => __("Rebuild all formats"), 584 -state => $::action_button_state, 585 -command => sub { 586 $mw->Busy(-recurse => 1); 587 info("Running fmtutil-sys --all, this may take some time ...\n"); 588 for my $l (`fmtutil-sys --all 2>&1`) { 589 info($l); 590 $mw->update; 591 } 592 $mw->Unbusy; 593 }); 594 $menu_actions->add('command', -label => __("Update font map database"), 595 -state => $::action_button_state, 596 -command => sub { 597 $mw->Busy(-recurse => 1); 598 info("Running updmap-sys, this may take some time ...\n"); 599 for my $l (`updmap-sys 2>&1`) { 600 info($l); 601 $mw->update; 602 } 603 $mw->Unbusy; 604 }); 605 606 $menu_actions->add('command', 607 -label => __("Restore packages from backup") . " ...", 608 -state => $::action_button_state, 609 -command => \&cb_handle_restore); 610 611 if (!wndws()) { 612 $menu_actions->add('command', 613 -label => __("Handle symlinks in system dirs") . " ...", 614 -state => $::action_button_state, 615 -command => \&cb_handle_symlinks); 616 } 617 if (!wndws()) { 618 $menu_actions->add('separator'); 619 $menu_actions->add('command', -label => __("Remove TeX Live %s ...", $TeXLive::TLConfig::ReleaseYear), 620 -state => $::action_button_state, 621 -command => sub { 622 my $sw = $mw->DialogBox(-title => __("Remove TeX Live %s", $TeXLive::TLConfig::ReleaseYear), 623 -buttons => [ __("Ok"), __("Cancel") ], 624 -cancel_button => __("Cancel"), 625 -command => sub { 626 my $b = shift; 627 if ($b eq __("Ok")) { 628 system("tlmgr", "remove", "--all", "--force"); 629 $mw->Dialog(-text => __("Complete removal finished"), -buttons => [ __("Ok") ])->Show; 630 $mw->destroy; 631 exit(0); 632 } 633 }); 634 $sw->add("Label", -text => __("Really remove (uninstall) the COMPLETE TeX Live %s installation?\nYour last chance to change your mind!", $TeXLive::TLConfig::ReleaseYear))->pack(@p_iii); 635 $sw->Show; 636 }); 637 } 638 639 640 641 # 642 # HELP MENU 643 $menu_help->add('command', -label => __("Manual"), -command => \&pod_to_text); 644 $menu_help->add('command', -label => __("About"), 645 -command => sub { 646 my $sw = $mw->DialogBox(-title => __("About"), 647 -buttons => [ __("Ok") ]); 648 $sw->add("Label", -text => "TeX Live Manager 649 650 tlmgrgui revision $tlmgrguirevision 651 $tlmgrrev 652 Copyright 2009-2017 Norbert Preining 653 654 Licensed under the GNU General Public License version 2 or higher 655 In case of problems, please contact: texlive\@tug.org" 656 )->pack(@p_iii); 657 $sw->Show; 658 }); 659 660 661 $mw->configure(-menu => $menu); 662 } 663 664 sub show_extended_info { 665 my $p = shift; 666 $g->selectionClear; 667 $g->anchorClear; 668 my $sw = $mw->Toplevel(-title => __("Details on:") . $p, @p_ii); 669 $sw->transient($mw); 670 671 my $tlp = $Packages{$p}{'tlp'}; 672 673 our $tf = $sw->Frame; 674 my $bf = $sw->Frame; 675 $tf->pack; 676 $bf->pack(-pady => '3m'); 677 678 $tf->Label(-text => __("Package:"))->grid( 679 $tf->Label(-text => $p), -sticky => "nw"); 680 $tf->Label(-text => __("Category:"))->grid( 681 $tf->Label(-text => $tlp->category), -sticky => "nw"); 682 $tf->Label(-text => __("Short description:"))->grid( 683 $tf->Label(-wraplength => '500', -justify => 'left', 684 -text => $tlp->shortdesc), -sticky => "nw"); 685 # old version with ROText 686 #my $t = $sw->Scrolled('ROText', -scrollbars => "oe", -height => 10, 687 # -width => 50, -wrap => 'word', -relief => 'flat'); 688 #$t->insert("1.0", $tlp->longdesc); 689 #$sw->Label(-text => "Long desc:")->grid($t, -sticky => 'nw'); 690 $tf->Label(-text => __("Long description:"))->grid( 691 $tf->Label(-wraplength => '500', -justify => 'left', 692 -text => $tlp->longdesc), -sticky => "nw"); 693 $tf->Label(-text => __("Installed:"))->grid( 694 $tf->Label(-text => ($Packages{$p}{'installed'} ? __("Yes") : __("No"))), 695 -sticky => "nw"); 696 $tf->Label(-text => __("Local revision:"))->grid( 697 $tf->Label(-text => $Packages{$p}{'localrevision'}), 698 -sticky => "nw"); 699 if (defined($Packages{$p}{'localcatalogueversion'})) { 700 $tf->Label(-text => __("Local Catalogue version:"))->grid( 701 $tf->Label(-text => $Packages{$p}{'localcatalogueversion'}), 702 -sticky => "nw"); 703 } 704 $tf->Label(-text => __("Remote revision:"))->grid( 705 $tf->Label(-text => $Packages{$p}{'remoterevisionstring'}), 706 -sticky => "nw"); 707 if (defined($Packages{$p}{'remotecatalogueversion'})) { 708 $tf->Label(-text => __("Remote Catalogue version:"))->grid( 709 $tf->Label(-text => $Packages{$p}{'remotecatalogueversion'}), 710 -sticky => "nw"); 711 } 712 if (defined($Packages{$p}{'keyword'})) { 713 $tf->Label(-text => __("Keywords:"))->grid( 714 $tf->Label(-text => $Packages{$p}{'keyword'}), 715 -sticky => "nw"); 716 } 717 if (defined($Packages{$p}{'functionality'})) { 718 $tf->Label(-text => __("Functionality:"))->grid( 719 $tf->Label(-text => $Packages{$p}{'functionality'}), 720 -sticky => "nw"); 721 } 722 if (defined($Packages{$p}{'primary'})) { 723 $tf->Label(-text => __("Primary characterization:"))->grid( 724 $tf->Label(-text => $Packages{$p}{'primary'}), 725 -sticky => "nw"); 726 } 727 if (defined($Packages{$p}{'secondary'})) { 728 $tf->Label(-text => __("Secondary characterization:"))->grid( 729 $tf->Label(-text => $Packages{$p}{'secondary'}), 730 -sticky => "nw"); 731 } 732 if ($remotetlpdb) { 733 my @colls; 734 if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") { 735 @colls = $remotetlpdb->needed_by($tlp->name); 736 } 737 @colls = grep {m;^collection-;} @colls; 738 if (@colls) { 739 $tf->Label(-text => __("Collection:"))->grid( 740 $tf->Label(-text => "@colls"), -sticky => "nw"); 741 } 742 } 743 $tf->Label(-text => __("Warning: Catalogue versions might be lagging behind or be simply wrong."))->grid(-stick => "nw", -columnspan => 2); 744 745 our %further_a; 746 our %further_b; 747 748 @{$further_a{$p}} = (); 749 @{$further_b{$p}} = (); 750 751 sub add_filelist_text { 752 my $p = shift; 753 my $text = shift; 754 my @files = @_; 755 if (@files) { 756 my $t = ""; 757 for my $f (@files) { $t .= "$f\n"; } 758 $t =~ s/\n$//; 759 push @{$further_a{$p}}, $tf->Label(-text => $text); 760 if ($#files >= 4) { 761 my $foo = $tf->Scrolled('ROText', -scrollbars => "oe", -height => 5, 762 -width => 50, -wrap => 'word', -relief => 'flat'); 763 $foo->insert("1.0", $t); 764 push @{$further_b{$p}}, $foo; 765 } else { 766 push @{$further_b{$p}}, 767 $tf->Label(-wraplength => '500', -justify => 'left', -text => $t); 768 } 769 } 770 } 771 my @deps; 772 my $do_arch; 773 my @arch_deps; 774 for my $d ($tlp->depends) { 775 if ($d eq "$p.ARCH") { 776 $do_arch = 1; 777 } else { 778 push @deps, $d; 779 } 780 } 781 add_filelist_text($p, __("Depends:"), @deps); 782 if ($do_arch) { 783 my @archs = $localtlpdb->available_architectures; 784 @arch_deps = map { "$p.$_"; } @archs; 785 add_filelist_text($p, __("Binaries' dependencies:"), sort(@arch_deps)); 786 } 787 add_filelist_text($p, __("Runfiles:"), $tlp->runfiles); 788 add_filelist_text($p, __("Docfiles:"), $tlp->docfiles); 789 add_filelist_text($p, __("Srcfiles:"), $tlp->srcfiles); 790 my @binf = $tlp->allbinfiles; 791 if ($do_arch) { 792 for my $bp (@arch_deps) { 793 my $tlpb = $localtlpdb->get_package($bp); 794 if (!$tlpb) { 795 tlwarn("Cannot find $bp.\n"); 796 } else { 797 push @binf, $tlpb->allbinfiles; 798 } 799 } 800 } 801 add_filelist_text($p, __("Binfiles:"), @binf); 802 803 my $f = $tf->Frame; 804 my $fb = $f->Button(-padx => 0, -pady => 0, 805 -text => "+", -borderwidth => 1, -relief => "ridge"); 806 my $ff = $f->Label(-text => "------ " . __("Further information") . " ------"); 807 $fb->grid($ff, -sticky => "nw"); 808 809 $f->grid(-sticky => "nw", -columnspan => 2); 810 my $showdetails = 0; 811 $fb->configure(-command => 812 sub { 813 $showdetails = not($showdetails); 814 if ($showdetails) { 815 for my $i (0..$#{$further_a{$p}}) { 816 ${$further_a{$p}}[$i]->grid(${$further_b{$p}}[$i], -sticky => "nw"); 817 } 818 } else { 819 for my $i (0..$#{$further_a{$p}}) { 820 ${$further_a{$p}}[$i]->gridForget(${$further_b{$p}}[$i]); 821 } 822 } 823 }); 824 825 826 $bf->Button(-text => __("Ok"), -width => 10, 827 -command => sub { for (@{$further_a{$p}}) { $_->destroy; }; 828 for (@{$further_b{$p}}) { $_->destroy; }; 829 $sw->destroy; })->pack; 830 } 831 832 sub update_grid { 833 # select code 834 # if not given just do nothing 835 # if == 1 select all packages that will be shown 836 # if == 0 deselect all packages that will be shown 837 my $selectcode = shift; 838 839 my @schemes; 840 my @colls; 841 my @packs; 842 for my $p (sort keys %Packages) { 843 if ($Packages{$p}{'category'} eq "Scheme") { 844 push @schemes, $p; 845 } elsif ($Packages{$p}{'category'} eq "Collection") { 846 push @colls, $p; 847 } else { 848 push @packs, $p; 849 } 850 } 851 $g->delete('all'); 852 my $i = 0; 853 my @displist; 854 my $crit_match = 0; 855 if (@critical_updates) { 856 @displist = @critical_updates; 857 $crit_match = 1; 858 $lighttext->configure(-foreground => 'red'); 859 $darktext->configure(-foreground => 'red'); 860 $update_all_button->configure(-text => __('Update the TeX Live Manager')); 861 } else { 862 @displist = (@schemes, @colls, @packs); 863 } 864 my %match_hit; 865 for my $p (@displist) { 866 $match_hit{$p} = 1 if MatchesFilters($p); 867 } 868 my @match_keys = keys %match_hit; 869 for my $p (@displist) { 870 if ($crit_match || defined($match_hit{$p})) { 871 if (defined($selectcode)) { 872 $Packages{$p}{'selected'} = $selectcode; 873 } 874 $g->add($p); 875 my $st = ($i%2 ? $lighttext : $darktext); 876 $g->itemCreate($p, 0, -itemtype => 'window', 877 -widget => $Packages{$p}{'cb'}); 878 $Packages{$p}{'cb'}->configure(-background => ($i%2?'gray90':'gray70')); 879 $g->itemCreate($p, 1, -itemtype => 'text', -style => $st, 880 -text => $Packages{$p}{'displayname'}); 881 my $t = ($Packages{$p}{'localrevision'} || ''); 882 if ($Packages{$p}{'localcatalogueversion'}) { 883 $t .= " ($Packages{$p}{'localcatalogueversion'})"; 884 } 885 $g->itemCreate($p, 2, -itemtype => 'text', -style => $st, -text => $t); 886 $t = ($Packages{$p}{'remoterevisionstring'} || ''); 887 if ($Packages{$p}{'remotecatalogueversion'}) { 888 $t .= " ($Packages{$p}{'remotecatalogueversion'})"; 889 } 890 $g->itemCreate($p, 3, -itemtype => 'text', -style => $st, -text => $t); 891 $g->itemCreate($p, 4, -itemtype => 'text', -style => $st, 892 -text => $Packages{$p}{'tlp'}->shortdesc); 893 $i++; 894 } 895 } 896 } 897 898 sub maybe_strip_last_plus { 899 my $v = shift; 900 if ($v =~ m/\+$/) { 901 chop($v); 902 # just for comparison add one to the version of there is a "+" 903 $v++; 904 } 905 return $v; 906 } 907 908 sub MatchesFilters { 909 my $p = shift; 910 # we have to take care since strings in revision numbers on the remote 911 # and might contain "+" indicating sub-package updates 912 # status 913 if (( ($status_value == $status_all) ) || 914 ( ($status_value == $status_only_installed) && 915 (defined($Packages{$p}{'installed'})) && 916 ($Packages{$p}{'installed'} == 1) ) || 917 ( ($status_value == $status_only_not_installed) && 918 ( !defined($Packages{$p}{'installed'}) || 919 ($Packages{$p}{'installed'} == 0)) ) || 920 ( ($status_value == $status_only_updated) && 921 (defined($Packages{$p}{'localrevision'})) && 922 (defined($Packages{$p}{'remoterevision'})) && 923 ($Packages{$p}{'localrevision'} < 924 maybe_strip_last_plus($Packages{$p}{'remoterevision'})))) { 925 # do nothing, more checks have to be done 926 } else { 927 return 0; 928 } 929 # category 930 if (($show_packages && ($Packages{$p}{'category'} eq 'Other')) || 931 ($show_collections && ($Packages{$p}{'category'} eq 'Collection')) || 932 ($show_schemes && ($Packages{$p}{'category'} eq 'Scheme')) ) { 933 # do nothing, more checks have to be done 934 } else { 935 return 0; 936 } 937 # 938 # match dealing 939 # 940 # * search string empty 941 # -> true 942 # * search string non-empty 943 # + some search targets selected 944 # -> check 945 # + no search target selected 946 # -> show empty list (maybe show warning "select something") 947 # 948 if ($match_descriptions || $match_filenames) { 949 my $found = 0; 950 my $r = $match_text; 951 if ($r eq "") { 952 return 1; 953 } 954 # check first for the default search type, the descriptions 955 # also match the remoterevisionstring to get search for repositories 956 if ($match_descriptions) { 957 if ($Packages{$p}{'match_desc'} =~ m/$r/i) { 958 $found = 1; 959 } elsif (defined($Packages{$p}{'remoterevisionstring'}) && 960 $Packages{$p}{'remoterevisionstring'} =~ m/$r/i) { 961 $found = 1; 962 } 963 } 964 # if we already found something, don't check the next condition! 965 if (!$found) { 966 if ($match_filenames) { 967 if ($Packages{$p}{'match_files'} =~ m/$r/i) { 968 $found = 1; 969 } 970 } 971 } 972 if (!$found) { 973 # not matched in either of the above cases, return 0 immediately 974 return 0; 975 } 976 # otherwise more checks have to be done 977 } else { 978 if ($match_text eq "") { 979 return 1; 980 } else { 981 # we could give a warning "select something" but HOW??? 982 return 0; 983 } 984 } 985 # selection 986 if ($selection_value == 0) { 987 # all -> maybe more checks 988 } elsif ($selection_value == 1) { 989 # only selected 990 if ($Packages{$p}{'selected'}) { 991 # do nothing, maybe more checks 992 } else { 993 # not selected package and only selected packages shown 994 return 0; 995 } 996 } else { 997 # only not selected 998 if ($Packages{$p}{'selected'}) { 999 # selected, but only not selected should be shown 1000 return 0; 1001 } # else do nothing 1002 } 1003 # if we come down to here the package matches 1004 return 1; 1005 } 1006 1007 ############# ARCH HANDLING ##################### 1008 1009 sub init_archs { 1010 if (!defined($remotetlpdb)) { 1011 @archsavail = $localtlpdb->available_architectures; 1012 } else { 1013 @archsavail = $remotetlpdb->available_architectures; 1014 } 1015 $currentarch = $localtlpdb->platform(); 1016 @archsinstalled = $localtlpdb->available_architectures; 1017 foreach my $a (@archsavail) { 1018 $archs{$a} = 0; 1019 if (grep(/^$a$/,@archsinstalled)) { 1020 $archs{$a} = 1; 1021 } 1022 } 1023 } 1024 1025 1026 sub do_arch_settings { 1027 my $sw = $mw->Toplevel(-title => __("Select platforms to support")); 1028 my %archsbuttons; 1029 init_archs(); 1030 $sw->transient($mw); 1031 $sw->grab(); 1032 my $subframe = $sw->Labelframe(-text => __("Select platforms to support")); 1033 $subframe->pack(-fill => "both", -padx => "2m", -pady => "2m"); 1034 foreach my $a (sort @archsavail) { 1035 $archsbuttons{$a} = 1036 $subframe->Checkbutton(-command => sub { check_on_removal($sw, $a); }, 1037 -variable => \$archs{$a}, 1038 -text => platform_desc($a) 1039 )->pack(-anchor => 'w'); 1040 } 1041 my $arch_frame = $sw->Frame; 1042 $arch_frame->pack(-padx => "10m", -pady => "5m"); 1043 $arch_frame->Button(-text => __("Apply changes"), 1044 -state => $::action_button_state, 1045 -command => sub { apply_arch_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1046 $arch_frame->Button(-text => __("Cancel"), 1047 -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1048 } 1049 1050 sub check_on_removal { 1051 my $arch_frame = shift; 1052 my $a = shift; 1053 if (!$archs{$a} && $a eq $currentarch) { 1054 # removal not supported 1055 $archs{$a} = 1; 1056 $arch_frame->Dialog(-title => __("Warning"), 1057 -text => __("Removals of the main platform not possible!"), 1058 -buttons => [ __("Ok") ])->Show; 1059 } 1060 } 1061 1062 sub apply_arch_changes { 1063 my @todo_add; 1064 my @todo_remove; 1065 foreach my $a (@archsavail) { 1066 if (!$archs{$a} && grep(/^$a$/,@archsinstalled)) { 1067 push @todo_remove, $a; 1068 next; 1069 } 1070 if ($archs{$a} && !grep(/^$a$/,@archsinstalled)) { 1071 push @todo_add, $a; 1072 next; 1073 } 1074 } 1075 if (@todo_add) { 1076 execute_action_gui ( "platform", "add", @todo_add ); 1077 } 1078 if (@todo_remove) { 1079 execute_action_gui ( "platform", "remove", @todo_remove ); 1080 } 1081 if (@todo_add || @todo_remove) { 1082 reinit_local_tlpdb(); 1083 init_archs(); 1084 } 1085 } 1086 1087 1088 ######### CONFIG HANDLING ############# 1089 1090 sub init_defaults_setting { 1091 for my $key (keys %TeXLive::TLConfig::TLPDBOptions) { 1092 if ($TeXLive::TLConfig::TLPDBOptions{$key}->[0] eq "b") { 1093 $defaults{$key} = ($localtlpdb->option($key) ? 1 : 0); 1094 } else { 1095 $defaults{$key} = $localtlpdb->option($key); 1096 } 1097 } 1098 %changeddefaults = (); 1099 for my $k (keys %defaults) { 1100 $changeddefaults{$k}{'changed'} = 0; 1101 $changeddefaults{$k}{'value'} = $defaults{$k}; 1102 if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") { 1103 $changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No")); 1104 } else { 1105 if ($k eq "file_assocs") { 1106 $changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}]; 1107 } elsif ($k eq "location") { 1108 if ($#tlpdb_tags > 0) { 1109 # we are using multiple repositories 1110 $changeddefaults{$k}{'display'} = __("multiple repositories"); 1111 } else { 1112 $changeddefaults{$k}{'display'} = $defaults{$k}; 1113 } 1114 } else { 1115 $changeddefaults{$k}{'display'} = $defaults{$k}; 1116 } 1117 } 1118 } 1119 } 1120 1121 sub do_general_settings { 1122 my $sw = $mw->Toplevel(-title => __("General options")); 1123 $sw->transient($mw); 1124 $sw->grab(); 1125 init_defaults_setting(); 1126 1127 my @config_set_l; 1128 my @config_set_m; 1129 my @config_set_r; 1130 1131 my $back_config_set = $sw->Labelframe(-text => __("General options")); 1132 my $back_config_buttons = $sw->Frame(); 1133 $back_config_set->pack(-fill => "both", -padx => "2m", -pady => "2m"); 1134 1135 push @config_set_l, 1136 $back_config_set->Label(-text => __("Default package repository"), -anchor => "w"); 1137 1138 1139 $location_button = $back_config_set->Button(-relief => 'flat', 1140 -textvariable => \$changeddefaults{"location"}{'display'}); 1141 1142 push @config_set_m, $location_button; 1143 push @config_set_r, 1144 $back_config_set->Button(-text => __("Change"), 1145 -command => sub { menu_multi_location($sw); }); 1146 1147 if ($#tlpdb_tags > 0) { 1148 my @vals = map { "$_:$tlpdb_repos{$_}" } sort sort_main_first @tlpdb_tags; 1149 $location_button->configure( 1150 -command => sub { transient_show_multiple_repos($location_button, @vals); }); 1151 } 1152 1153 $settings_label{'location'} = $location_button; 1154 1155 if ($mode_expert) { 1156 push @config_set_l, 1157 $back_config_set->Label(-text => __("Create formats on installation"), -anchor => "w"); 1158 $settings_label{'create_formats'} = $back_config_set->Label(-textvariable => \$changeddefaults{"create_formats"}{'display'}); 1159 push @config_set_m, $settings_label{'create_formats'}; 1160 push @config_set_r, 1161 $back_config_set->Button(-text => __("Toggle"), 1162 -command => sub { toggle_setting("create_formats"); }); 1163 1164 push @config_set_l, $back_config_set->Label(-text => __("Install macro/font sources"), -anchor => "w"); 1165 $settings_label{'install_srcfiles'} = $back_config_set->Label(-textvariable => \$changeddefaults{"install_srcfiles"}{'display'}); 1166 push @config_set_m, $settings_label{'install_srcfiles'}; 1167 push @config_set_r, 1168 $back_config_set->Button(-text => __("Toggle"), 1169 -command => sub { toggle_setting("install_srcfiles"); }); 1170 1171 push @config_set_l, $back_config_set->Label(-text => __("Install macro/font docs"), -anchor => "w"); 1172 $settings_label{'install_docfiles'} = $back_config_set->Label(-textvariable => \$changeddefaults{"install_docfiles"}{'display'}); 1173 push @config_set_m, $settings_label{'install_docfiles'}; 1174 push @config_set_r, 1175 $back_config_set->Button(-text => __("Toggle"), 1176 -command => sub { toggle_setting("install_docfiles"); }); 1177 1178 push @config_set_l, $back_config_set->Label(-text => __("Default backup directory"), -anchor => "w"); 1179 $settings_label{'backupdir'} = $back_config_set->Label(-textvariable => \$changeddefaults{"backupdir"}{'display'}); 1180 push @config_set_m, $settings_label{'backupdir'}; 1181 push @config_set_r, 1182 $back_config_set->Button(-text => __("Change"), 1183 -command => sub { edit_dir_option ($sw, "backupdir"); }); 1184 1185 push @config_set_l, 1186 $back_config_set->Label(-text => __("Auto backup setting"), -anchor => "w"); 1187 $settings_label{'autobackup'} = $back_config_set->Label(-textvariable => \$changeddefaults{"autobackup"}{'display'}); 1188 push @config_set_m, $settings_label{'autobackup'}; 1189 push @config_set_r, 1190 $back_config_set->Button(-text => __("Change"), 1191 -command => sub { select_autobackup($sw); }); 1192 1193 if (!wndws()) { 1194 push @config_set_l, 1195 $back_config_set->Label(-text => __("Link destination for programs"), -anchor => "w"); 1196 $settings_label{'sys_bin'} = $back_config_set->Label(-textvariable => \$changeddefaults{"sys_bin"}{'display'}); 1197 push @config_set_m, $settings_label{'sys_bin'}; 1198 push @config_set_r, 1199 $back_config_set->Button(-text => __("Change"), 1200 -command => sub { edit_dir_option ($sw, "sys_bin"); }); 1201 1202 push @config_set_l, 1203 $back_config_set->Label(-text => __("Link destination for info docs"), -anchor => "w"); 1204 $settings_label{'sys_info'} = $back_config_set->Label(-textvariable => \$changeddefaults{"sys_info"}{'display'}); 1205 push @config_set_m, $settings_label{'sys_info'}; 1206 push @config_set_r, 1207 $back_config_set->Button(-text => __("Change"), 1208 -command => sub { edit_dir_option ($sw, "sys_info"); }); 1209 1210 push @config_set_l, 1211 $back_config_set->Label(-text => __("Link destination for man pages"), -anchor => "w"); 1212 $settings_label{'sys_man'} = $back_config_set->Label(-textvariable => \$changeddefaults{"sys_man"}{'display'}); 1213 push @config_set_m, $settings_label{'sys_man'}; 1214 push @config_set_r, 1215 $back_config_set->Button(-text => __("Change"), 1216 -command => sub { edit_dir_option ($sw, "sys_man"); }); 1217 } 1218 1219 if (wndws()) { 1220 push @config_set_l, 1221 $back_config_set->Label(-text => __("Create shortcuts on the desktop"), -anchor => "w"); 1222 $settings_label{'desktop_integration'} = $back_config_set->Label(-textvariable => \$changeddefaults{"desktop_integration"}{'display'}); 1223 push @config_set_m, $settings_label{'desktop_integration'}; 1224 push @config_set_r, 1225 $back_config_set->Button(-text => __("Toggle"), 1226 -command => sub { toggle_setting("desktop_integration"); }); 1227 1228 if (admin()) { 1229 push @config_set_l, 1230 $back_config_set->Label(-text => __("Install for all users"), -anchor => "w"); 1231 $settings_label{'w32_multi_user'} = $back_config_set->Label(-textvariable => \$changeddefaults{"w32_multi_user"}{'display'}); 1232 push @config_set_m, $settings_label{'w32_multi_user'}; 1233 push @config_set_r, 1234 $back_config_set->Button(-text => __("Toggle"), 1235 -command => sub { toggle_setting("w32_multi_user"); }); 1236 } 1237 1238 push @config_set_l, 1239 $back_config_set->Label(-text => __("Change file associations"), -anchor => "w"); 1240 $settings_label{'file_assocs'} = $back_config_set->Label(-textvariable => \$changeddefaults{'file_assocs'}{'display'}); 1241 push @config_set_m, $settings_label{'file_assocs'}; 1242 push @config_set_r, 1243 $back_config_set->Button(-text => __("Change"), 1244 -command => sub { select_file_assocs($sw); }); 1245 1246 } 1247 } # of $mode_export 1248 1249 for my $i (0..$#config_set_l) { 1250 $config_set_l[$i]->grid( $config_set_m[$i], $config_set_r[$i], 1251 -padx => "1m", -pady => "1m", -sticky => "nwe"); 1252 } 1253 1254 $back_config_buttons->pack(-padx => "10m", -pady => "5m"); 1255 $back_config_buttons->Button(-text => __("Apply changes"), 1256 -state => $::action_button_state, 1257 -command => sub { apply_settings_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1258 $back_config_buttons->Button(-text => __("Cancel"), 1259 -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1260 } 1261 1262 sub apply_settings_changes { 1263 for my $k (keys %defaults) { 1264 if ($defaults{$k} ne $changeddefaults{$k}{'value'}) { 1265 $localtlpdb->option($k, $changeddefaults{$k}{'value'}); 1266 if ($k eq "location") { 1267 # change interface to program, too 1268 # set default tlpdb location 1269 $tlpdb_location = $changeddefaults{'location'}{'value'}; 1270 # update tlpdb_repos and tlpdb_tags accordingly 1271 %tlpdb_repos = repository_to_array($tlpdb_location); 1272 @tlpdb_tags = keys %tlpdb_repos; 1273 # change the menu entry in File->Load default... 1274 if ($#tlpdb_tags > 0) { 1275 my @vals = map { "$_:$tlpdb_repos{$_}" } 1276 sort sort_main_first keys %tlpdb_repos; 1277 $menu_file->entryconfigure(1, -label => __("Load default repository:") . " " . __("multiple repositories")); 1278 } else { 1279 $menu_file->entryconfigure(1, -label => __("Load default repository:") . " $tlpdb_location"); 1280 } 1281 } 1282 } 1283 } 1284 $localtlpdb->save; 1285 } 1286 1287 1288 1289 ########## PAPER HANDLING ################# 1290 1291 sub init_paper_xdvi { 1292 if (!wndws()) { 1293 $papers{"xdvi"} = TeXLive::TLPaper::get_paper_list("xdvi"); 1294 $currentpaper{"xdvi"} = $papers{"xdvi"}->[0]; 1295 } 1296 } 1297 sub init_paper_pdftex { 1298 $papers{"pdftex"} = TeXLive::TLPaper::get_paper_list("pdftex"); 1299 $currentpaper{"pdftex"} = $papers{"pdftex"}->[0]; 1300 } 1301 sub init_paper_dvips { 1302 $papers{"dvips"} = TeXLive::TLPaper::get_paper_list("dvips"); 1303 $currentpaper{"dvips"} = $papers{"dvips"}->[0]; 1304 } 1305 sub init_paper_context { 1306 if (defined($localtlpdb->get_package("bin-context"))) { 1307 $papers{"context"} = TeXLive::TLPaper::get_paper_list("context"); 1308 $currentpaper{"context"} = $papers{"context"}->[0]; 1309 } 1310 } 1311 sub init_paper_dvipdfmx { 1312 $papers{"dvipdfmx"} = TeXLive::TLPaper::get_paper_list("dvipdfmx"); 1313 $currentpaper{"dvipdfmx"} = $papers{"dvipdfmx"}->[0]; 1314 } 1315 1316 sub init_paper_psutils { 1317 $papers{"psutils"} = TeXLive::TLPaper::get_paper_list("psutils"); 1318 $currentpaper{"psutils"} = $papers{"psutils"}->[0]; 1319 } 1320 1321 1322 sub init_all_papers { 1323 for my $p (keys %init_paper_subs) { 1324 my $pkg = $TeXLive::TLPaper::paper{$p}{'pkg'}; 1325 if ($localtlpdb->get_package($pkg)) { 1326 &{$init_paper_subs{$p}}(); 1327 } 1328 } 1329 } 1330 1331 1332 sub do_paper_settings { 1333 # empty paper array 1334 %papers = (); 1335 init_all_papers(); 1336 my $sw = $mw->Toplevel(-title => __("Paper options")); 1337 $sw->transient($mw); 1338 $sw->grab(); 1339 1340 %changedpaper = %currentpaper; 1341 1342 my $lower = $sw->Frame; 1343 $lower->pack(-fill => "both"); 1344 1345 my $back_config_pap = $lower->Labelframe(-text => __("Paper options")); 1346 my $back_config_buttons = $sw->Frame(); 1347 1348 1349 my $back_config_pap_l1 = $back_config_pap->Label(-text => __("Default paper for all"), -anchor => "w"); 1350 my $back_config_pap_m1 = $back_config_pap->Button(-text => __("A4"), 1351 -command => sub { change_paper("all", "a4"); }); 1352 my $back_config_pap_r1 = $back_config_pap->Button(-text => __("Letter"), 1353 -command => sub { change_paper("all", "letter"); }); 1354 1355 $back_config_pap_l1->grid( $back_config_pap_m1, $back_config_pap_r1, 1356 -padx => "2m", -pady => "2m", -sticky => "nswe"); 1357 1358 my (%l,%m,%r); 1359 if ($mode_expert) { 1360 foreach my $p (sort keys %papers) { 1361 if (($p eq "context") && !defined($localtlpdb->get_package("bin-context"))) { 1362 next; 1363 } 1364 $l{$p} = $back_config_pap->Label(-text => __("Default paper for %s", $p), -anchor => "w"); 1365 $m{$p} = $back_config_pap->Label(-textvariable => \$changedpaper{$p}, -anchor => "w"); 1366 $settings_label{$p} = $m{$p}; 1367 $r{$p} = $back_config_pap->Button(-text => __("Change"), 1368 -command => sub { select_paper($sw,$p); }, -anchor => "w"); 1369 $l{$p}->grid( $m{$p}, $r{$p}, 1370 -padx => "2m", -pady => "2m", -sticky => "nsw"); 1371 } 1372 } 1373 1374 $back_config_pap->pack(-side => 'left', -fill => "both", -padx => "2m", -pady => "2m"); 1375 1376 $back_config_buttons->pack(-padx => "10m", -pady => "5m"); 1377 $back_config_buttons->Button(-text => __("Apply changes"), 1378 -state => $::action_button_state, 1379 -command => sub { apply_paper_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1380 $back_config_buttons->Button(-text => __("Cancel"), 1381 -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 1382 } 1383 1384 sub do_gui_language_setting { 1385 my $sw = $mw->Toplevel(-title => __("GUI Language")); 1386 my %code_lang = ( 1387 cs => "Czech", 1388 de => "German", 1389 en => "English", 1390 es => "Spanish", 1391 fr => "French", 1392 it => "Italian", 1393 ja => "Japanese", 1394 nl => "Dutch", 1395 pl => "Polish", 1396 "pt_BR" => "Brasilian", 1397 ru => "Russian", 1398 sk => "Slovak", 1399 sl => "Slovenian", 1400 sr => "Serbian", 1401 uk => "Ukrainian", 1402 vi => "Vietnamese", 1403 "zh_CN" => "Simplified Chinese", 1404 "zh_TW" => "Traditional Chinese" 1405 ); 1406 1407 $sw->transient($mw); 1408 $sw->grab(); 1409 my $var = __("System default"); 1410 $var = $config{"gui-lang"} if (defined($config{"gui-lang"})); 1411 $var = $opts{"gui-lang"} if (defined($opts{"gui-lang"})); 1412 $var = (defined($code_lang{$var}) ? $code_lang{$var} : $var); 1413 my $opt = $sw->BrowseEntry(-label => __("Default language for GUI:"), -variable => \$var); 1414 $opt->insert(0, __("System default")); 1415 my @ll; 1416 foreach my $p (<$Master/tlpkg/translations/*.po>) { 1417 $p =~ s!^.*translations/!!; 1418 $p =~ s!\.po$!!; 1419 push @ll, $p; 1420 } 1421 # add English as possible language! 1422 push @ll, "en"; 1423 foreach my $l (sort @ll) { 1424 my $el = (defined($code_lang{$l}) ? $code_lang{$l} : $l); 1425 $opt->insert("end", $el); 1426 } 1427 $opt->pack(-padx => "2m", -pady => "2m"); 1428 $sw->Label(-text => __("Changes will take effect after restart"))->pack(-padx => "2m", -pady => "2m"); 1429 my $f = $sw->Frame; 1430 my $okbutton = $f->Button(-text => __("Ok"), 1431 -command => sub { 1432 if ($var eq __("System default")) { 1433 # we have to remove the setting in the config file 1434 delete($config{'gui-lang'}); 1435 write_config_file(); 1436 } else { 1437 for my $l (keys %code_lang) { 1438 if ($code_lang{$l} eq $var) { 1439 if (!defined($config{'gui-lang'}) || 1440 (defined($config{'gui-lang'}) && ($config{'gui-lang'} ne $l))) { 1441 $config{'gui-lang'} = $l; 1442 write_config_file(); 1443 } 1444 last; 1445 } 1446 } 1447 } 1448 $sw->destroy; 1449 })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1450 my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $sw->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1451 $f->pack; 1452 $sw->bind('<Return>', [ $okbutton, 'Invoke' ]); 1453 $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1454 } 1455 1456 sub do_and_warn_gui_mode_settings { 1457 my $ans = $mw->Dialog(-text => __("Changes will take effect after restart"), 1458 -title => __("Expert options"), 1459 -default_button => 'Ok', 1460 -buttons => [__("Ok"), __("Cancel")])->Show; 1461 if ($ans eq __("Ok")) { 1462 $config{"gui-expertmode"} = $mode_expert; 1463 write_config_file(); 1464 } 1465 } 1466 1467 sub ask_one_repository { 1468 my ($mw, $title, $info) = @_; 1469 my $val; 1470 my $done; 1471 my $sw = $mw->Toplevel(-title => $title); 1472 $sw->transient($mw); 1473 $sw->withdraw; 1474 $sw->Label(-text => $info)->pack(-padx => "2m", -pady => "2m"); 1475 1476 my $f1 = $sw->Frame; 1477 my @mirror_list; 1478 push @mirror_list, " " . __("Default remote repository") . ": http://mirror.ctan.org"; 1479 push @mirror_list, TeXLive::TLUtils::create_mirror_list(); 1480 my $entry = $f1->BrowseEntry( 1481 -listheight => 12, 1482 -listwidth => 400, 1483 -width => 50, 1484 -autolistwidth => 1, 1485 -choices => \@mirror_list, 1486 -browsecmd => 1487 sub { 1488 if ($val !~ m/^ /) { 1489 $val = ""; 1490 } elsif ($val =~ m!(http|ftp)://!) { 1491 $val = TeXLive::TLUtils::extract_mirror_entry($val); 1492 } else { 1493 $val =~ s/^\s*//; 1494 } 1495 }, 1496 -variable => \$val)->pack(-side => "left",-padx => "2m", -pady => "2m"); 1497 1498 #my $entry = $f1->Entry(-text => $val, -width => 50); 1499 #$entry->pack(-side => "left",-padx => "2m", -pady => "2m"); 1500 1501 my $f2 = $sw->Frame; 1502 $f2->Button(-text => __("Choose directory"), 1503 -command => sub { 1504 $val = $sw->chooseDirectory; 1505 #if (defined($var)) { 1506 # $entry->delete(0,"end"); 1507 # $entry->insert(0,$var); 1508 #} 1509 })->pack(-side => "left",-padx => "2m", -pady => "2m"); 1510 $f2->Button(-text => __("Default remote repository"), 1511 -command => sub { 1512 #$entry->delete(0,"end"); 1513 #$entry->insert(0,$TeXLiveURL); 1514 $val = $TeXLiveURL; 1515 })->pack(-side => "left",-padx => "2m", -pady => "2m"); 1516 $f1->pack; 1517 $f2->pack; 1518 1519 my $f = $sw->Frame; 1520 my $okbutton = $f->Button(-text => __("Ok"), 1521 -command => sub { $done = 1; } 1522 )->pack(-side => 'left',-padx => "2m", -pady => "2m"); 1523 my $cancelbutton = $f->Button(-text => __("Cancel"), 1524 -command => sub { $val = undef; $done = 1; } 1525 )->pack(-side => 'right',-padx => "2m", -pady => "2m"); 1526 $f->pack(-expand => 'x'); 1527 $sw->bind('<Return>', [ $okbutton, 'Invoke' ]); 1528 $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1529 my $old_focus = $sw->focusSave; 1530 my $old_grab = $sw->grabSave; 1531 $sw->Popup; 1532 $sw->grab; 1533 $sw->waitVariable(\$done); 1534 $sw->grabRelease if Tk::Exists($sw); 1535 $sw->destroy if Tk::Exists($sw); 1536 return $val; 1537 } 1538 1539 #sub menu_default_location { 1540 # my $mw = shift; 1541 # my $ret = ask_one_repository($mw, __("Change default package repository"), 1542 # __("New default package repository")); 1543 # if (defined($ret)) { 1544 # $changeddefaults{'location'}{'value'} = 1545 # $changeddefaults{'location'}{'display'} = $ret; 1546 # } 1547 #} 1548 1549 sub sort_main_first { 1550 if ($a eq 'main') { 1551 if ($b eq 'main') { 1552 return 0; 1553 } else { 1554 return -1; 1555 } 1556 } else { 1557 if ($b eq 'main') { 1558 return 1; 1559 } else { 1560 return ($a cmp $b); 1561 } 1562 } 1563 } 1564 1565 sub menu_multi_location { 1566 my $mw = shift; 1567 my $val; 1568 our $sw = $mw->Toplevel(-title => __("Edit default package repositories")); 1569 $sw->transient($mw); 1570 $sw->grab(); 1571 $sw->Label(-text => __("Specify set of repositories to be used"))->pack(-padx => "2m", -pady => "2m"); 1572 1573 our $f1 = $sw->Frame; 1574 my @entry_tag; our $tagw = 10; 1575 my @entry_loc; our $locw = 30; 1576 my @entry_del; 1577 my @entry_chg; 1578 1579 my $addrepo_button; 1580 1581 1582 sub add_buttons { 1583 my ($ref) = @_; 1584 my $t = $ref->{'tag'}; 1585 $ref->{'tag_w'} = $f1->Entry(-textvariable => \$ref->{'tag'}, -state => ($t eq "main" ? 'readonly' : 'normal'), -width => $tagw); 1586 $ref->{'val_w'} = $f1->Entry(-textvariable => \$ref->{'val'}, -width => $locw); 1587 $ref->{'del_w'} = $f1->Button(-text => __("Delete"), 1588 -state => ($t eq "main" ? 'disabled' : 'normal'), 1589 -command => sub { 1590 $ref->{'status'} = 0; 1591 $ref->{'tag_w'}->configure(-state => 'disabled'); 1592 $ref->{'val_w'}->configure(-state => 'disabled'); 1593 $ref->{'del_w'}->configure(-state => 'disabled'); 1594 $ref->{'chg_w'}->configure(-state => 'disabled'); 1595 }); 1596 $ref->{'chg_w'} = $f1->Button(-text => __("Change"), 1597 -command => sub { 1598 our $sw; 1599 my $ret = ask_one_repository($sw, 1600 ($t eq "main" ? 1601 __("Change main package repository") : 1602 __("Change subsidiary package repository")), 1603 ($t eq "main" ? 1604 __("Change main package repository") : 1605 __("Change subsidiary package repository"))); 1606 $ref->{'val'} = $ret if (defined($ret)); 1607 }); 1608 } 1609 1610 my %changed_repos = repository_to_array($changeddefaults{'location'}{'value'}); 1611 1612 my @edit_repos; 1613 push @edit_repos, { 'tag' => 'main', 'val' => $changed_repos{'main'}, 'status' => 1}; 1614 for my $k (sort keys %changed_repos) { 1615 next if ($k eq "main"); 1616 push @edit_repos, { 'tag'=> $k, 'val' => $changed_repos{$k}, 'status' => 1 }; 1617 } 1618 for my $ref (@edit_repos) { 1619 add_buttons($ref); 1620 } 1621 for my $ref (@edit_repos) { 1622 my %foo = %$ref; 1623 $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'}, 1624 -padx => "1m", -pady => "1m", -sticky => "nwe"); 1625 } 1626 $addrepo_button = $f1->Button(-text => __("Add repository") . "...", 1627 -command => sub { 1628 my $ret = ask_one_repository($sw, __("Add package repository"), 1629 __("Add package repository")); 1630 if (defined($ret)) { 1631 $addrepo_button->gridForget; 1632 my %foo = ( 'tag' => $ret, 'val' => $ret, 'status' => 1 ); 1633 add_buttons(\%foo); 1634 $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'}, 1635 -padx => "1m", -pady => "1m", -sticky => "nwe"); 1636 push @edit_repos, \%foo; 1637 } 1638 $addrepo_button->grid(-columnspan => 2, -column => 2); 1639 }); 1640 $addrepo_button->grid(-columnspan => 2, -column => 2); 1641 1642 $f1->pack; 1643 1644 my $f = $sw->Frame; 1645 my $okbutton = $f->Button(-text => __("Ok"), 1646 -command => 1647 sub { 1648 # we have to check if something has changed ... and for consistency!!! 1649 my %new_repos; 1650 for my $ref (@edit_repos) { 1651 my %foo = %$ref; 1652 if ($foo{'status'}) { 1653 if (defined($new_repos{$foo{'tag'}})) { 1654 $sw->Dialog(-title => __("Warning"), 1655 -text => __("Repository tag name already used: %s", $foo{'tag'}), -buttons => [ __("Ok") ])->Show; 1656 return; 1657 } 1658 $new_repos{$foo{'tag'}} = $foo{'val'}; 1659 } 1660 } 1661 my $differs = 0; 1662 for my $k (keys %changed_repos) { 1663 if (!defined($new_repos{$k})) { 1664 $differs = 1; 1665 last; 1666 } 1667 if ($changed_repos{$k} ne $new_repos{$k}) { 1668 $differs = 1; 1669 last; 1670 } 1671 } 1672 if (!$differs) { 1673 # do the same the other way round 1674 for my $k (keys %new_repos) { 1675 if (!defined($changed_repos{$k})) { 1676 $differs = 1; 1677 last; 1678 } 1679 if ($changed_repos{$k} ne $new_repos{$k}) { 1680 $differs = 1; 1681 last; 1682 } 1683 } 1684 } 1685 1686 if ($differs) { 1687 # print "current repos:\n"; 1688 # for my $ref (@edit_repos) { 1689 # print "tag = $ref->{'tag'}\n"; 1690 # print "val = $ref->{'val'}\n"; 1691 # print "act = $ref->{'status'}\n"; 1692 # } 1693 $changeddefaults{'location'}{'value'} = array_to_repository(%new_repos); 1694 my @vals = map { "$_:$new_repos{$_}" } 1695 sort sort_main_first keys %new_repos; 1696 if ($#vals > 0) { 1697 $location_button->configure( 1698 -command => sub { transient_show_multiple_repos($location_button, @vals); }); 1699 $changeddefaults{'location'}{'display'} = __("multiple repositories"); 1700 } else { 1701 $changeddefaults{'location'}{'display'} = $changeddefaults{'location'}{'value'}; 1702 } 1703 } else { 1704 # print "Nothing happend!\n"; 1705 } 1706 $location_button->configure(-background => 1707 ($changeddefaults{'location'}{'value'} eq $defaults{'location'} ? 1708 $bgcolor : 'red')); 1709 $sw->destroy; 1710 })->pack(-side => 'left',-padx => "2m", -pady => "2m"); 1711 my $cancelbutton = $f->Button(-text => __("Cancel"), 1712 -command => sub { $sw->destroy })->pack(-side => 'right',-padx => "2m", -pady => "2m"); 1713 my $resetbutton = $f->Button(-text => __("Revert"), 1714 -command => sub { $sw->destroy; menu_multi_location($mw); })->pack(-side => 'right',-padx => "2m", -pady => "2m"); 1715 $f->pack(-expand => 'x'); 1716 $sw->bind('<Return>', [ $okbutton, 'Invoke' ]); 1717 $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1718 } 1719 1720 sub toggle_setting() { 1721 my ($key) = @_; 1722 my $old = $changeddefaults{$key}{'value'}; 1723 my $new = ($old ? 0 : 1); 1724 $changeddefaults{$key}{'display'} = ($new ? __("Yes") : __("No")); 1725 $changeddefaults{$key}{'value'} = $new; 1726 if (defined($settings_label{$key})) { 1727 if ($defaults{$key} ne $changeddefaults{$key}{'value'}) { 1728 $settings_label{$key}->configure(-background => 'red'); 1729 } else { 1730 $settings_label{$key}->configure(-background => $bgcolor); 1731 } 1732 } 1733 } 1734 1735 1736 sub apply_paper_changes { 1737 $mw->Busy(-recurse => 1); 1738 for my $k (keys %changedpaper) { 1739 if ($currentpaper{$k} ne $changedpaper{$k}) { 1740 execute_action_gui ( "paper", $k, "paper", $changedpaper{$k}); 1741 &{$init_paper_subs{$k}}(); 1742 } 1743 } 1744 $mw->Unbusy; 1745 } 1746 1747 sub change_paper { 1748 my ($prog, $pap) = @_; 1749 if ($prog eq "all") { 1750 for my $k (keys %changedpaper) { 1751 $changedpaper{$k} = $pap; 1752 $settings_label{$k}->configure(-background => 1753 ($changedpaper{$k} eq $currentpaper{$k} ? $bgcolor : 'red')); 1754 } 1755 } else { 1756 $changedpaper{$prog} = $pap; 1757 $settings_label{$prog}->configure(-background => 1758 ($changedpaper{$prog} eq $currentpaper{$prog} ? $bgcolor : 'red')); 1759 } 1760 } 1761 1762 sub select_paper { 1763 my $back_config = shift; 1764 my $prog = shift; 1765 my $foo = $back_config->Toplevel(-title => __("Select paper format for %s", $prog)); 1766 $foo->transient($back_config); 1767 $foo->grab(); 1768 my $var = $changedpaper{$prog}; 1769 my $opt = $foo->BrowseEntry(-label => __("Default paper for %s", $prog), -variable => \$var); 1770 foreach my $p (sort @{$papers{$prog}}) { 1771 $opt->insert("end",$p); 1772 } 1773 $opt->pack(-padx => "2m", -pady => "2m"); 1774 my $f = $foo->Frame; 1775 my $okbutton = $f->Button(-text => __("Ok"), -command => sub { change_paper($prog,$var); $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1776 my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1777 $f->pack; 1778 $foo->bind('<Return>', [ $okbutton, 'Invoke' ]); 1779 $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1780 } 1781 1782 sub select_autobackup { 1783 my $mw = shift; 1784 my $foo = $mw->Toplevel(-title => __("Auto backup setting")); 1785 $foo->transient($mw); 1786 $foo->grab(); 1787 #my $var = $defaults{"autobackup"}; 1788 my $var = $changeddefaults{"autobackup"}{'value'}; 1789 my $opt = $foo->BrowseEntry(-label => __("Auto backup setting"), 1790 -variable => \$var); 1791 my @al; 1792 push @al, "-1 (" . __("keep arbitrarily many") . ")"; 1793 push @al, "0 (" . __("disable") . ")"; 1794 for my $i (1..100) { 1795 push @al, $i; 1796 } 1797 foreach my $p (@al) { 1798 $opt->insert("end",$p); 1799 } 1800 $opt->pack(-padx => "2m", -pady => "2m"); 1801 my $f = $foo->Frame; 1802 my $okbutton = $f->Button(-text => __("Ok"), 1803 -command => sub { 1804 $var =~ s/ .*$//; 1805 $changeddefaults{"autobackup"}{'value'} = $var; 1806 $changeddefaults{"autobackup"}{'display'} = $var; 1807 $settings_label{'autobackup'}->configure( 1808 -background => 1809 ($var eq $defaults{"autobackup"} ? $bgcolor : 'red')); 1810 $foo->destroy; 1811 } 1812 )->pack(-side => "left", -padx => "2m", -pady => "2m"); 1813 my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1814 $f->pack; 1815 $foo->bind('<Return>', [ $okbutton, 'Invoke' ]); 1816 $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1817 } 1818 1819 1820 sub select_file_assocs { 1821 my $sw = shift; 1822 my $foo = $sw->Toplevel(-title => __("Change file associations")); 1823 $foo->transient($mw); 1824 $foo->grab(); 1825 my $var = $defaults{"file_assocs"}; 1826 my $opt = $foo->BrowseEntry(-label => __("Change file associations"), 1827 -variable => \$var); 1828 my @al; 1829 for my $i (0..2) { 1830 push @al, "$i $fileassocdesc[$i]"; 1831 } 1832 foreach my $p (@al) { 1833 $opt->insert("end",$p); 1834 } 1835 $opt->pack(-padx => "2m", -pady => "2m"); 1836 my $f = $foo->Frame; 1837 my $okbutton = $f->Button(-text => __("Ok"), 1838 -command => sub { 1839 $var = substr($var,0,1); 1840 $changeddefaults{"file_assocs"}{'display'} = $fileassocdesc[$var]; 1841 $changeddefaults{"file_assocs"}{'value'} = $var; 1842 1843 $foo->destroy; 1844 } 1845 )->pack(-side => "left", -padx => "2m", -pady => "2m"); 1846 my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m"); 1847 $f->pack; 1848 $foo->bind('<Return>', [ $okbutton, 'Invoke' ]); 1849 $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 1850 } 1851 1852 1853 1854 ############################ 1855 1856 sub setup_location { 1857 my $loc = shift; 1858 $location = $loc; 1859 # first check if $location contains multiple locations 1860 # in this case we go to virtual mode 1861 %repos = (); 1862 %repos = repository_to_array($location); 1863 @tags = keys %repos; 1864 if ($#tags == 0) { 1865 $single_repo_mode = 1; 1866 } else { 1867 $single_repo_mode = 0; 1868 } 1869 run_update_functions(); 1870 } 1871 1872 sub init_install_media { 1873 my $newroot = $location; 1874 if (defined($remotetlpdb) && !$remotetlpdb->is_virtual && 1875 ($remotetlpdb->root eq $newroot)) { 1876 # nothing to be done 1877 } else { 1878 $mw->Busy(-recurse => 1); 1879 my ($ret, $err) = init_tlmedia(); 1880 $mw->Unbusy; 1881 if (!$ret) { 1882 # something went badly wrong, maybe the newroot is wrong? 1883 $mw->Dialog(-title => __("Warning"), 1884 -text => __("Loading of remote database failed.") . "\n" . 1885 __("Error message:") . "\n$err\n\n", 1886 -buttons => [ __("Ok") ])->Show; 1887 $remotetlpdb = undef; 1888 update_list_remote(); 1889 update_grid(); 1890 update_loaded_location_string("none"); 1891 } else { 1892 update_list_remote(); 1893 update_grid(); 1894 update_loaded_location_string($location); 1895 } 1896 } 1897 } 1898 1899 sub set_text_win { 1900 my ($w, $t) = @_; 1901 $w->delete("0.0", "end"); 1902 $w->insert("0.0", "$t"); 1903 $w->see("0.0"); 1904 } 1905 1906 sub install_selected_packages { 1907 my @foo = SelectedPackages(); 1908 if (@foo) { 1909 # that doesn't hurt if it is already loaded 1910 # it does hurt when there are critical updates ... so don't do it 1911 #init_install_media(); 1912 my @args = qw/install/; 1913 push @args, @foo; 1914 execute_action_gui(@args); 1915 reinit_local_tlpdb(); 1916 # now we check that the installation has succeeded by checking that 1917 # all packages in @_ are installed. Otherwise we pop up a warning window 1918 my $do_warn = 0; 1919 for my $p (@_) { 1920 if (!defined($localtlpdb->get_package($p))) { 1921 $do_warn = 1; 1922 last; 1923 } 1924 } 1925 give_warning_window(__("Installation"), @_) if $do_warn; 1926 } 1927 } 1928 1929 sub SelectedPackages { 1930 my @ret; 1931 # first select those that are 1932 for my $p (keys %Packages) { 1933 next if !$Packages{$p}{'selected'}; 1934 if (MatchesFilters($p)) { 1935 push @ret, $p; 1936 } 1937 } 1938 return @ret; 1939 } 1940 1941 sub critical_updates_done_msg_and_end { 1942 # terminate here immediately so that we are sure the auto-updater 1943 # is run immediately 1944 # warn that program will now be terminated 1945 $mw->Dialog(-title => __("Warning"), 1946 -text => __("Critical updates have been installed.\nProgram will terminate now.\nPlease restart if necessary."), 1947 -buttons => [ __("Ok") ])->Show; 1948 # also delete the main window before we kill the process to 1949 # make sure that Tk is happy (segfault on cmd line, email Taco) 1950 $mw->destroy; 1951 # don't call finish(0) as we need to exit immediately 1952 exit(0); 1953 } 1954 1955 sub update_all_packages { 1956 my @args = qw/update/; 1957 if (@critical_updates) { 1958 $opts{"self"} = 1; 1959 } else { 1960 $opts{"all"} = 1; 1961 } 1962 # that doesn't hurt if it is already loaded 1963 # it does hurt when there are critical updates ... so don't do it 1964 #init_install_media(); 1965 execute_action_gui(qw/update/); 1966 if (@critical_updates) { 1967 critical_updates_done_msg_and_end(); 1968 } 1969 reinit_local_tlpdb(); 1970 } 1971 1972 sub update_selected_packages { 1973 my @foo = SelectedPackages(); 1974 if (@foo) { 1975 # that doesn't hurt if it is already loaded 1976 # it does hurt when there are critical updates ... so don't do it 1977 #init_install_media(); 1978 my @args = qw/update/; 1979 # argument processing 1980 # in case we have critical updates present we do put the list of 1981 # critical updates into the argument instead of --all 1982 if (@critical_updates) { 1983 $opts{"self"} = 1; 1984 } 1985 push @args, @foo; 1986 execute_action_gui(@args); 1987 if (@critical_updates) { 1988 critical_updates_done_msg_and_end(); 1989 } 1990 reinit_local_tlpdb(); 1991 } 1992 } 1993 1994 sub remove_selected_packages { 1995 my @foo = SelectedPackages(); 1996 if (@foo) { 1997 my @args = qw/remove/; 1998 push @args, @foo; 1999 execute_action_gui(@args); 2000 reinit_local_tlpdb(); 2001 my $do_warn = 0; 2002 for my $p (@_) { 2003 if (defined($localtlpdb->get_package($p))) { 2004 $do_warn = 1; 2005 last; 2006 } 2007 } 2008 give_warning_window(__("Remove"), @_) if $do_warn; 2009 } 2010 } 2011 2012 sub backup_selected_packages { 2013 my @foo = SelectedPackages(); 2014 if (@foo) { 2015 my @args = qw/backup/; 2016 push @args, @foo; 2017 execute_action_gui(@args); 2018 } 2019 } 2020 2021 sub reinit_local_tlpdb { 2022 $mw->Busy(-recurse => 1); 2023 $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master"); 2024 die("cannot find tlpdb!") unless (defined($localtlpdb)); 2025 setup_list(); 2026 update_grid(); 2027 $mw->Unbusy; 2028 } 2029 2030 # 2031 # sub populate_Packages 2032 # 2033 sub populate_Packages { 2034 my ($mode, $tlp, $maxtag) = @_; 2035 my $p = $tlp->name; 2036 $Packages{$p}{'displayname'} = $p; 2037 if ($mode eq "local") { 2038 $Packages{$p}{'localrevision'} = $tlp->revision; 2039 $Packages{$p}{'installed'} = 1; 2040 $Packages{$p}{'selected'} = 0; 2041 delete($Packages{$p}{'tlp'}) if defined($Packages{$p}{'tlp'}); 2042 $Packages{$p}{'tlp'} = $tlp; 2043 } else { 2044 $Packages{$p}{'remoterevision'} = $tlp->revision; 2045 $Packages{$p}{'remoterevisionstring'} = $tlp->revision; 2046 if ($remotetlpdb->is_virtual) { 2047 $Packages{$p}{'remoterevisionstring'} .= "\@$maxtag"; 2048 } 2049 $Packages{$p}{'selected'} = 0 2050 unless defined $Packages{$p}{'selected'}; 2051 if (!defined($Packages{$p}{'tlp'})) { 2052 $Packages{$p}{'tlp'} = $tlp; 2053 } 2054 } 2055 $Packages{$p}{'match_desc'} = "$p\n"; 2056 $Packages{$p}{'match_desc'} .= ($tlp->shortdesc || ""); 2057 $Packages{$p}{'match_desc'} .= "\n"; 2058 $Packages{$p}{'match_desc'} .= ($tlp->longdesc || ""); 2059 # 2060 # file matching 2061 my @all_f = $tlp->all_files; 2062 if ($tlp->relocated) { for (@all_f) { s:^$RelocPrefix/:$RelocTree/:; } } 2063 $Packages{$p}{'match_files'} = "@all_f"; 2064 if ($mode eq "local") { 2065 $Packages{$p}{'cb'}->destroy() if defined($Packages{$p}{'cb'}); 2066 $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'}); 2067 } else { 2068 $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'}) 2069 unless defined $Packages{$p}{'cb'}; 2070 } 2071 if (($tlp->category eq "Collection") || 2072 ($tlp->category eq "Scheme")) { 2073 $Packages{$p}{'category'} = $tlp->category; 2074 } else { 2075 $Packages{$p}{'category'} = "Other"; 2076 } 2077 if (defined($tlp->cataloguedata->{'version'})) { 2078 if ($mode eq "local") { 2079 $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'}; 2080 } else { 2081 $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'}; 2082 } 2083 } 2084 } 2085 2086 # 2087 # creates/updates the list of packages as shown in tix grid 2088 # 2089 sub setup_list { 2090 my @do_later; 2091 for my $p ($localtlpdb->list_packages()) { 2092 # skip 00texlive packages 2093 next if ($p =~ m!^00texlive!); 2094 # collect packages containing a . for later 2095 # we want to ignore them in most cases but those where there is 2096 # no father package (without .) 2097 if ($p =~ m;\.;) { 2098 push @do_later, $p; 2099 next; 2100 } 2101 my $tlp = $localtlpdb->get_package($p); 2102 populate_Packages("local", $tlp); 2103 } 2104 my @avail_arch = $localtlpdb->available_architectures; 2105 for my $p (@do_later) { 2106 my ($mp, $ma) = ($p =~ m/^(.*)\.([^.]*)$/); 2107 if (!defined($mp)) { 2108 tlerror("very strange, above it matched and now not anymore?!?! $p\n"); 2109 next; 2110 } 2111 if (!defined($Packages{$mp})) { 2112 my $tlp = $localtlpdb->get_package($p); 2113 populate_Packages("local", $tlp); 2114 } else { 2115 # two cases: 2116 # - $mp.$ma where $ma is in available_archs 2117 # check if $pkg itself has been update present, otherwise 2118 # add a "+" to the revision number of the upstream package 2119 # but do NOT show the sub package 2120 # 2121 # this has to be deferred to later processing as we don't have 2122 # this information at hand at this time 2123 # 2124 # - $pkg.$arch where $arch is NOT in available_arch 2125 # thus it was installed by the user, show it 2126 # 2127 if (!TeXLive::TLUtils::member($ma, @avail_arch)) { 2128 my $tlp = $localtlpdb->get_package($p); 2129 populate_Packages("local", $tlp); 2130 } 2131 } 2132 } 2133 update_list_remote(); 2134 } 2135 2136 sub update_list_remote { 2137 my @do_later_media; 2138 #my $handle; 2139 #Devel::Leak::NoteSV($handle); 2140 # clear old info from remote media 2141 for my $p (keys %Packages) { 2142 if (!$Packages{$p}{'installed'}) { 2143 $Packages{$p}{'cb'}->destroy() if defined($Packages{$p}{'cb'}); 2144 delete($Packages{$p}{'tlp'}) if defined($Packages{$p}{'tlp'}); 2145 delete $Packages{$p}; 2146 next; 2147 } 2148 delete $Packages{$p}{'remoterevision'}; 2149 delete $Packages{$p}{'remoterevisionstring'}; 2150 delete $Packages{$p}{'remotecatalogueversion'}; 2151 } 2152 if (defined($remotetlpdb)) { 2153 for my $p ($remotetlpdb->list_packages()) { 2154 # skip 00texlive packages 2155 next if ($p =~ m!^00texlive!); 2156 if ($p =~ m;\.;) { 2157 push @do_later_media, $p; 2158 next; 2159 } 2160 my $tlp; 2161 my $maxtag; 2162 if ($remotetlpdb->is_virtual) { 2163 ($maxtag, undef, $tlp, undef) = 2164 $remotetlpdb->virtual_candidate($p); 2165 } else { 2166 $tlp = $remotetlpdb->get_package($p); 2167 } 2168 populate_Packages("remote", $tlp, $maxtag); 2169 } 2170 } 2171 my @avail_arch = $localtlpdb->available_architectures; 2172 for my $p (@do_later_media) { 2173 my ($mp, $ma) = ($p =~ m/^(.*)\.([^.]*)$/); 2174 if (!defined($mp)) { 2175 tlerror("very strange, above it matched and now not anymore?!?! $p\n"); 2176 next; 2177 } 2178 my $tlp; 2179 my $maxtag; 2180 if ($remotetlpdb->is_virtual) { 2181 ($maxtag, undef, $tlp, undef) = 2182 $remotetlpdb->virtual_candidate($p); 2183 } else { 2184 $tlp = $remotetlpdb->get_package($p); 2185 } 2186 if (!defined($Packages{$mp})) { 2187 populate_Packages("remote", $tlp, $maxtag); 2188 } else { 2189 # two cases: 2190 # - $mp.$ma where $ma is in available_archs 2191 # check if $pkg itself has been update present, otherwise 2192 # add a "+" to the revision number of the upstream package 2193 # but do NOT show the sub package 2194 # We have to make sure that the remote version does not get 2195 # TWO times a + added. This can happen if you have multiple 2196 # architectures installed, and all of the .ARCH packages (more 2197 # than 1) are updated, but not the main package 2198 # 2199 if (TeXLive::TLUtils::member($ma, @avail_arch)) { 2200 if (defined($Packages{$mp}{'localrevision'}) && 2201 defined($Packages{$mp}{'remoterevision'}) && 2202 # a subpackage was already checked and found to be updated 2203 $Packages{$mp}{'remoterevision'} !~ m/\+$/ && 2204 $Packages{$mp}{'localrevision'} < $Packages{$mp}{'remoterevision'}) { 2205 # the main package is updated, so just do nothing 2206 } else { 2207 if ($Packages{$mp}{'remoterevision'} !~ m/\+$/) { 2208 # if there is an update to a binary sub package mark that with 2209 # a "+" in the remote revision 2210 my $ltlp = $localtlpdb->get_package($p); 2211 if (defined($ltlp) && $ltlp->revision < $tlp->revision) { 2212 $Packages{$mp}{'remoterevision'} .= "+"; 2213 } 2214 } 2215 # no else clause, in this case the main package is not updated, 2216 # but already one subpackage was checked and a + added, so don't 2217 # do anything 2218 } 2219 # - $pkg.$arch where $arch is NOT in available_arch 2220 # thus it was installed by the user, show it 2221 # 2222 } else { 2223 # only show that one if it is locally installed 2224 if (defined($Packages{$p})) { 2225 populate_Packages("remote", $tlp, $maxtag); 2226 } 2227 } 2228 } 2229 } 2230 # 2231 # check for critical updates 2232 my @critical = $localtlpdb->expand_dependencies("-no-collections", 2233 $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList); 2234 @critical_updates = (); 2235 for my $p (@critical) { 2236 if (defined($Packages{$p}) && 2237 defined($Packages{$p}{'localrevision'}) && 2238 defined($Packages{$p}{'remoterevision'}) && 2239 $Packages{$p}{'localrevision'} < $Packages{$p}{'remoterevision'}) { 2240 push @critical_updates, $p; 2241 } 2242 } 2243 # 2244 # 2245 if (@critical_updates) { 2246 # add to the warning text if further updates are available 2247 # compute the number of further updates 2248 # we do NOT make a correct computation here like done in the actual 2249 # tlmgr.pl sub action_update, but only count the numbers of packages 2250 # that would be updated (without any forcibly remove/new counting) 2251 my $min_action = 0; 2252 for my $p (keys %Packages) { 2253 next if member($p, @critical); 2254 if (defined($Packages{$p}{'localrevision'}) && 2255 defined($Packages{$p}{'remoterevision'}) && 2256 $Packages{$p}{'localrevision'} < 2257 maybe_strip_last_plus($Packages{$p}{'remoterevision'})) { 2258 $min_action++; 2259 } 2260 } 2261 # 2262 # create the warning dialog 2263 # 2264 my $sw = $mw->DialogBox(-title => __("Warning"), -buttons => [ __("Ok") ]); 2265 my $t = __("The TeX Live manager (the software you're currently running) 2266 needs to be updated before any other updates can be done. 2267 2268 Please do this by clicking the \"Update the TeX Live Manager\" button, 2269 after dismissing this dialogue. 2270 2271 After the update, the TeX Live manager will terminate. 2272 You can then restart it to proceed with further updates."); 2273 if ($min_action) { 2274 $t .= "\n\n" 2275 . __("(Further updates will be available after tlmgr has been updated.)"); 2276 } 2277 $t .= "\n\n" . __("Please wait a bit after the program has terminated so that the update can be completed.") if wndws(); 2278 $sw->add("Label", -text => $t)->pack(-padx => "3m", -pady => "3m"); 2279 $sw->Show; 2280 } 2281 #Devel::Leak::CheckSV($handle); 2282 #warn join(",", currmem()); 2283 } 2284 2285 sub currmem { 2286 my $pid = shift || $$; 2287 if (open(MAP, "dd if=/proc/$pid/map bs=64k 2>/dev/null |")) { # FreeBSD 2288 my $mem = 0; 2289 my $realmem = 0; 2290 while(<MAP>) { 2291 my(@l) = split /\s+/; 2292 my $delta = (hex($l[1])-hex($l[0])); 2293 $mem += $delta; 2294 if ($l[11] ne 'vnode') { 2295 $realmem += $delta; 2296 } 2297 } 2298 close MAP; 2299 ($mem, $realmem); 2300 } elsif (open(MAP, "/proc/$pid/maps")) { # Linux 2301 my $mem = 0; 2302 my $realmem = 0; 2303 while(<MAP>) { 2304 my(@l) = split /\s+/; 2305 my($start,$end) = split /-/, $l[0]; 2306 my $delta = (hex($end)-hex($start)); 2307 $mem += $delta; 2308 if (!defined $l[5] || $l[5] eq '') { 2309 $realmem += $delta; 2310 } 2311 } 2312 close MAP; 2313 ($mem, $realmem); 2314 } else { 2315 undef; 2316 } 2317 } 2318 2319 sub cb_handle_restore { 2320 init_defaults_setting(); 2321 # first do the handling of the backup dir selection 2322 { 2323 my ($a, $b) = check_backupdir_selection(); 2324 if ($a != $F_OK) { 2325 # in all these cases we want to terminate in the non-gui mode 2326 my $sw = $mw->DialogBox(-title => __("Warning"), -buttons => [ __("Ok") ]); 2327 $sw->add("Label", -text => $b)->pack(@p_iii); 2328 $sw->Show; 2329 # delete the backupdir setting it might contain rubbish and 2330 # we want to recheck 2331 delete $opts{'backupdir'}; 2332 return; 2333 } 2334 } 2335 2336 my $sw = $mw->Toplevel(-title => __("Restore packages from backup")); 2337 $sw->transient($mw); 2338 $sw->grab; 2339 2340 my $tf = $sw->Frame; 2341 $tf->pack(-ipadx => '3m', -ipady => '3m'); 2342 2343 my %backups = get_available_backups($opts{"backupdir"}); 2344 2345 my @pkgbackup = sort keys %backups; 2346 my $lstlen = ($#pkgbackup >= 10 ? 10 : ($#pkgbackup + 1)); 2347 2348 my $pkg; 2349 my $rev; 2350 2351 my $restore_dialog = $sw->DialogBox(-title => __("Restore completed"), 2352 -buttons => [ __("Ok") ]); 2353 $restore_dialog->add("Label", -text => __("Restore completed"))->pack(@p_iii); 2354 2355 2356 my $revbrowser; 2357 2358 $tf->Label(-text => __("Select the package to restore, or restore all packages"))->pack(@p_ii); 2359 2360 $tf->BrowseEntry(-label => __("Package:"), 2361 -listheight => $lstlen, 2362 -autolistwidth => 1, 2363 -choices => \@pkgbackup, 2364 -browsecmd => 2365 sub { my @revlist = sort { $b <=> $a } (keys %{$backups{$pkg}}); 2366 $revbrowser->delete(0,"end"); 2367 for my $r (@revlist) { 2368 $revbrowser->insert("end", $r); 2369 }; 2370 $rev = ""; 2371 }, 2372 -variable => \$pkg)->pack(@p_ii); 2373 2374 $revbrowser = $tf->BrowseEntry(-label => __("Revision:"), 2375 -listheight => 10, 2376 -variable => \$rev)->pack(@p_ii); 2377 2378 $tf->pack(-ipadx => '3m', -ipady => '3m'); 2379 $tf->Button(-text => __("Restore selected package"), 2380 -command => sub { 2381 if (!defined($pkg) || !defined($rev) || 2382 !($backups{$pkg}->{$rev})) { 2383 tlwarn("Please select a package and revision first!\n"); 2384 return; 2385 } 2386 $mw->Busy(-recurse => 1); 2387 info("Restoring $pkg, rev $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.xz\n"); 2388 restore_one_package($pkg, $rev, $opts{"backupdir"}); 2389 reinit_local_tlpdb; 2390 $restore_dialog->Show; 2391 $pkg = ""; 2392 $rev = ""; 2393 $mw->Unbusy; 2394 })->pack(@p_ii); 2395 $tf->Button(-text => __("Restore all packages to latest version"), 2396 -command => sub { 2397 $mw->Busy(-recurse => 1); 2398 for my $p (@pkgbackup) { 2399 my @tmp = sort {$b <=> $a} (keys %{$backups{$p}}); 2400 my $r = $tmp[0]; 2401 info("Restoring $p, rev $r from $opts{'backupdir'}/${p}.r${r}.tar.xz\n"); 2402 restore_one_package($p, $r, $opts{"backupdir"}); 2403 } 2404 reinit_local_tlpdb; 2405 $restore_dialog->Show; 2406 $pkg = ""; 2407 $rev = ""; 2408 $mw->Unbusy; 2409 })->pack(@p_ii); 2410 2411 $tf->Button(-text => __("Close"), 2412 -command => sub { $sw->destroy; }) 2413 ->pack(@p_iii); 2414 } 2415 2416 2417 sub cb_handle_symlinks { 2418 my $sw = $mw->Toplevel(-title => __("Handle symlinks in system dirs")); 2419 $sw->transient($mw); 2420 $sw->grab; 2421 init_defaults_setting(); 2422 2423 my $tp = $sw->Frame; 2424 $tp->pack(-ipadx => '3m', -ipady => '3m'); 2425 $tp->Label(-text => __("Link destination for programs"), @a_w)->grid( 2426 $tp->Label(-textvariable => \$changeddefaults{"sys_bin"}{'display'}, @a_w), 2427 $tp->Button(-text => __("Change"), 2428 -command => sub { edit_dir_option ($sw, "sys_bin"); }), 2429 -sticky => 'w'); 2430 $tp->Label(-text => __("Link destination for info docs"), @a_w)->grid( 2431 $tp->Label(-textvariable => \$changeddefaults{"sys_info"}{'display'}, @a_w), 2432 $tp->Button(-text => __("Change"), 2433 -command => sub { edit_dir_option ($sw, "sys_info"); }), 2434 -sticky => 'w'); 2435 $tp->Label(-text => __("Link destination for man pages"), @a_w)->grid( 2436 $tp->Label(-textvariable => \$changeddefaults{"sys_man"}{'display'}, @a_w), 2437 $tp->Button(-text => __("Change"), 2438 -command => sub { edit_dir_option ($sw, "sys_man"); }), 2439 -sticky => 'w'); 2440 2441 my $md = $sw->Frame; 2442 $md->pack(-ipadx => '3m', -ipady => '3m'); 2443 $md->Button(-text => __("Update symbolic links"), 2444 -command => sub { 2445 $mw->Busy(-recurse => 1); 2446 info("Updating symlinks ...\n"); 2447 execute_action_gui("path", "add"); 2448 $mw->Unbusy; 2449 })->pack(@left, -padx => '3m'); 2450 $md->Button(-text => __("Remove symbolic links"), 2451 -command => sub { 2452 $mw->Busy(-recurse => 1); 2453 info("Removing symlinks ...\n"); 2454 execute_action_gui("path", "remove"); 2455 $mw->Unbusy; 2456 })->pack(@left, -padx => '3m'); 2457 2458 my $bt = $sw->Frame; 2459 $bt->pack(-ipadx => '3m', -ipady => '3m'); 2460 $bt->Button(-text => __("Ok"), 2461 -command => sub { apply_settings_changes(); $sw->destroy; }) 2462 ->pack(@left, -padx => '3m'); 2463 $bt->Button(-text => __("Cancel"), 2464 -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m"); 2465 } 2466 2467 sub edit_dir_option { 2468 my $sw = shift; 2469 my $what = shift; 2470 my $dir = cb_edit_string_or_dir($sw, $what, $changeddefaults{$what}{'value'}); 2471 if (defined($dir)) { 2472 $changeddefaults{$what}{'value'} = $dir; 2473 $changeddefaults{$what}{'display'} = $dir; 2474 $settings_label{$what}->configure( 2475 -background => ($defaults{$what} eq $dir ? $bgcolor : 'red')); 2476 } 2477 } 2478 2479 sub cb_edit_string_or_dir { 2480 my ($mw, $what, $cur) = @_; 2481 my $done; 2482 my $val; 2483 my $sw = $mw->Toplevel(-title => __("Edit directory")); 2484 $sw->transient($mw); 2485 $sw->withdraw; 2486 $sw->Label(-text => __("New value for %s:", $what))->pack(@p_ii); 2487 my $entry = $sw->Entry(-text => $cur, -width => 30); 2488 $entry->pack(@p_ii); 2489 $sw->Button(-text => __("Choose Directory"), 2490 -command => sub { 2491 my $var = $sw->chooseDirectory(); 2492 if (defined($var)) { 2493 $entry->delete(0,"end"); 2494 $entry->insert(0,$var); 2495 } 2496 })->pack(@p_ii); 2497 my $f = $sw->Frame; 2498 my $okbutton = $f->Button(-text => __("Ok"), 2499 -command => sub { $val = $entry->get; $done = 1; })->pack(@left, @p_ii); 2500 my $cancelbutton = $f->Button(-text => __("Cancel"), 2501 -command => sub { $val = undef; $done = 1 })->pack(@right, @p_ii); 2502 $f->pack(-expand => 1); 2503 $sw->bind('<Return>', [ $okbutton, 'Invoke' ]); 2504 $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 2505 my $old_focus = $sw->focusSave; 2506 my $old_grab = $sw->grabSave; 2507 $sw->Popup; 2508 $sw->grab; 2509 $sw->waitVariable(\$done); 2510 $sw->grabRelease if Tk::Exists($sw); 2511 $sw->destroy if Tk::Exists($sw); 2512 return $val; 2513 } 2514 2515 sub cb_edit_location { 2516 my $key = shift; 2517 my $okbutton; 2518 my $val; 2519 my $sw = $mw->Toplevel(-title => __("Load package repository")); 2520 $sw->transient($mw); 2521 $sw->grab(); 2522 $sw->Label(-text => __("Load this package repository:"))->pack(@p_ii); 2523 my @mirror_list; 2524 push @mirror_list, TeXLive::TLUtils::create_mirror_list(); 2525 my $entry = $sw->BrowseEntry( 2526 -listheight => 12, 2527 -listwidth => 400, 2528 -width => 50, 2529 -autolistwidth => 1, 2530 -choices => \@mirror_list, 2531 -browsecmd => 2532 sub { 2533 if ($val !~ m/^ /) { 2534 $val = ""; 2535 # $okbutton->configure(-state => 'disabled'); 2536 } elsif ($val =~ m!(http|ftp)://!) { 2537 $val = TeXLive::TLUtils::extract_mirror_entry($val); 2538 # $okbutton->configure(-state => 'normal'); 2539 } else { 2540 $val =~ s/^\s*//; 2541 # $okbutton->configure(-state => 'normal'); 2542 } 2543 }, 2544 -variable => \$val); 2545 # end new 2546 $entry->pack(@p_ii); 2547 my $f1 = $sw->Frame; 2548 $f1->Button(-text => __("Choose local directory"), 2549 -command => sub { 2550 my $var = $sw->chooseDirectory(); 2551 if (defined($var)) { 2552 $val = $var; 2553 # $okbutton->configure(-state => 'normal'); 2554 } 2555 })->pack(@left, @p_ii); 2556 $f1->Button(-text => __("Use standard net repository"), 2557 -command => sub { 2558 $val = $TeXLiveURL; 2559 # $okbutton->configure(-state => 'normal'); 2560 })->pack(@left, @p_ii); 2561 $f1->pack; 2562 my $f = $sw->Frame; 2563 $okbutton = $f->Button(-text => __("Load"), # -state => "disabled", 2564 -command => sub { 2565 if ($val) { 2566 $location = $val; 2567 $sw->destroy; 2568 my $foo = $mw->Toplevel(); 2569 $foo->transient($mw); 2570 $foo->overrideredirect(1); 2571 my $frame = $foo->Frame( -border => 5, -relief => 'groove' )->pack; 2572 $frame->Label( -text => __("Loading remote repository - this may take some time, please be patient ...") )->pack( -padx => 5 ); 2573 $foo->Popup(-popanchor => 'c'); 2574 setup_location($location); 2575 $foo->destroy; 2576 } else { 2577 # button should be disabled and not clickable 2578 # why are we here??? 2579 } 2580 })->pack(@left, @p_ii); 2581 my $cancelbutton = $f->Button(-text => __("Cancel"), 2582 -command => sub { $sw->destroy })->pack(@right, @p_ii); 2583 $f->pack(-expand => 1); 2584 $sw->bind('<Return>', [ $okbutton, 'Invoke' ]); 2585 $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]); 2586 } 2587 2588 sub update_loaded_location_string { 2589 my $arg = shift; 2590 $arg || ($arg = $location); 2591 my %repos = repository_to_array($arg); 2592 my @tags = sort keys %repos; 2593 my @vals; 2594 if ($#tags > 0) { 2595 @vals = map { 2596 "$_:$repos{$_} (" . 2597 ($remotetlpdb->virtual_get_tlpdb($_)->is_verified ? 2598 __("verified") : __("not verified")) . ")" 2599 } sort sort_main_first @tags; 2600 } else { 2601 $arg .= " (" . ($remotetlpdb->is_verified ? 2602 __("verified") : __("not verified")) . ")"; 2603 @vals = ( $arg ); 2604 } 2605 if ($#tags > 0) { 2606 $loaded_text_button->configure(-text => __("multiple repositories")); 2607 } else { 2608 $loaded_text_button->configure(-text => $arg); 2609 } 2610 $loaded_text->configure(-text => __("Loaded:")); 2611 $loaded_text_button->configure( -command => 2612 sub { transient_show_multiple_repos($loaded_text_button, @vals); }); 2613 $default_repo->packForget; 2614 } 2615 2616 sub transient_show_multiple_repos { 2617 my ($ref_widget, @vals) = @_; 2618 my $xx = $ref_widget->rootx; 2619 my $yy = $ref_widget->rooty + $ref_widget->reqheight; 2620 my $sw = $mw->Toplevel(-bd => 2); 2621 $sw->geometry("+$xx+$yy"); 2622 $sw->overrideredirect(1); 2623 $sw->transient($mw); 2624 $sw->grab; 2625 # we want to have a global grab, but that somehow does not work! 2626 #$sw->grabGlobal; 2627 $sw->bind('<1>', sub { $sw->grabRelease; $sw->destroy; }); 2628 my $foo = $sw->Listbox(-height => 0, -width => 0, 2629 -listvariable => \@vals, 2630 -state => 'normal'); 2631 $foo->pack; 2632 } 2633 2634 sub run_update_functions { 2635 foreach my $f (@update_function_list) { 2636 &{$f}(); 2637 } 2638 } 2639 2640 sub check_location_on_ctan { 2641 # we want to check that if mirror.ctan.org 2642 # is used that we select a mirror once 2643 for my $k (keys %repos) { 2644 if ($repos{$k} =~ m/$TeXLive::TLConfig::TeXLiveServerURL/) { 2645 $repos{$k} = TeXLive::TLUtils::give_ctan_mirror(); 2646 } 2647 } 2648 } 2649 2650 sub execute_action_gui { 2651 $mw->Busy(-recurse => 1); 2652 info ("Executing action @_\n"); 2653 my $error_code = execute_action(@_); 2654 if ($error_code) { 2655 give_warning_window(@_); 2656 } 2657 info(__("Completed") . ".\n"); 2658 $mw->Unbusy; 2659 } 2660 2661 sub give_warning_window { 2662 my ($act, @args) = @_; 2663 my $sw = $mw->DialogBox(-title => __("Warning"), -buttons => [ __("Ok") ]); 2664 $sw->add("Label", -text => __("Running %s failed.\nPlease consult the log window for details.", "$act @args") 2665 )->pack(@p_iii); 2666 $sw->Show; 2667 } 2668 2669 # pod help thing 2670 2671 sub pod_to_text { 2672 my $txt; 2673 eval { require IO::String; }; 2674 if ($@) { 2675 $txt = " 2676 The Perl Module IO::String is not available. 2677 Without it the documentation cannot be shown. Please install it. 2678 2679 As an alternative use 2680 tlmgr help 2681 on the command line. 2682 "; 2683 } else { 2684 my $io = IO::String->new($txt); 2685 my $parser = Pod::Text->new (sentence => 0, width => 78); 2686 $parser->parse_from_file("$Master/texmf-dist/scripts/texlive/tlmgr.pl", $io); 2687 } 2688 my $sw = $mw->Toplevel(-title => __("Help")); 2689 $sw->transient($mw); 2690 my $t = $sw->Scrolled("ROText", -scrollbars => "e", 2691 -height => 40, -width => 80); 2692 $t->Contents($txt); 2693 $t->pack; 2694 } 2695 2696 1; 2697 2698 __END__ 2699 2700 2701 ### Local Variables: 2702 ### perl-indent-level: 2 2703 ### tab-width: 2 2704 ### indent-tabs-mode: nil 2705 ### End: 2706 # vim:set tabstop=2 expandtab: #