diff options
author | Norbert Preining <norbert@preining.info> | 2020-04-22 03:02:46 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2020-04-22 03:02:46 +0000 |
commit | e0e2537ccbac6924b371be81092c1177e817162c (patch) | |
tree | 1ee747d3a078004710d37b5f3ddaa9d975bdded7 /systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl | |
parent | 8731cc5ad70723b9a155917df509d857579c355d (diff) |
CTAN sync 202004220302
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl')
-rwxr-xr-x | systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl | 99 |
1 files changed, 84 insertions, 15 deletions
diff --git a/systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl b/systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl index cd9001ea83..e831f8984b 100755 --- a/systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl +++ b/systems/texlive/tlnet/tlpkg/installer/install-tl-gui.tcl @@ -45,7 +45,12 @@ set ::instroot [file normalize [info script]] set ::instroot [file dirname [file dirname [file dirname $::instroot]]] # declarations, initializations and procs shared with tlshell.tcl +set ::invoker [file tail [info script]] +if [string match -nocase ".tcl" [string range $::invoker end-3 end]] { + set ::invoker [string range $::invoker 0 end-4] +} source [file join $::instroot "tlpkg" "tltcl" "tltcl.tcl"] +unset ::invoker ### initialize some globals ### @@ -408,7 +413,7 @@ proc make_splash {} { # some text ppack [ttk::label .text -text [__ "TeX Live Installer"] \ - -font bigfont] -in .bg + -font hfont] -in .bg if {! $::select_repo} { ppack [ttk::label .loading -text [__ "Trying to load %s. @@ -934,13 +939,6 @@ proc select_binaries {} { ppack .tlbin.cancel -in .tlbin.buts -side right bind .tlbin <Escape> {.tlbin.cancel invoke} - #set max_width 0 - #foreach b [array names ::bin_descs] { - # set bl [font measure TkTextFont [__ $::bin_descs($b)]] - # if {$bl > $max_width} {set max_width $bl} - #} - #incr max_width 10 - # treeview for binaries, with checkbox column and vertical scrollbar pack [ttk::frame .tlbin.binsf] -in .tlbin.bg -expand 1 -fill both @@ -1005,12 +1003,6 @@ proc select_scheme {} { bind .tlschm <Escape> {.tlschm.cancel invoke} # schemes list - #set max_width 0 - #foreach s $::schemes_order { - # set sl [font measure TkTextFont [__ $::scheme_descs($s)]] - # if {$sl > $max_width} {set max_width $sl} - #} - #incr max_width 10 ttk::treeview .tlschm.lst -columns {desc} -show {} -selectmode browse \ -height [llength $::schemes_order] .tlschm.lst column "desc" -stretch 1; # -minwidth $max_width @@ -1315,6 +1307,23 @@ if {$::tcl_platform(platform) ne "windows"} { ############################################################# +proc set_language {l} { + set ::lang $l + load_translations + run_menu +} + +proc set_fontscale {s} { + set ::tkfontscale $s + redo_fonts + run_menu +} + +# menus: disable tearoff feature +option add *Menu.tearOff 0 + +############################################################# + # the main menu interface will at certain events send the current values of # the ::vars array to install-tl[-tcl], which will send back an updated version # of this array. @@ -1324,6 +1333,17 @@ if {$::tcl_platform(platform) ne "windows"} { # for 3-way options, create an extra level of children # instead of wizard install, supppress some options +## default_bg color, only used for menus under ::plain_unix +if [catch {ttk::style lookup TFrame -background} ::default_bg] { + set ::default_bg white +} + +proc abort_menu {} { + set ::out_log {} + set ::menu_ans "no_inst" + # i.e. anything but advanced, alltrees or startinst +} + proc run_menu {} { if [info exists ::env(dbgui)] { #puts "\ndbgui: run_menu: advanced is now $::advanced" @@ -1334,7 +1354,56 @@ proc run_menu {} { catch {destroy $c} } - # wallpaper + if $::plain_unix { + # plain_unix: avoid a possible RenderBadPicture error on quitting + # when there is a menu. + # 'send' bypasses the bug by changing the shutdown sequence. + # 'tk appname <something>' restores 'send'. + bind . <Destroy> { + catch {tk appname appname} + } + } + + # menu, for language selection and font scaling + menu .mn + . configure -menu .mn + if $::plain_unix { + .mn configure -borderwidth 1 + .mn configure -background $::default_bg + } + menu .mn.file + .mn add cascade -label [__ "File"] -menu .mn.file + .mn.file add command -command abort_menu -label [__ "Abort"] + + menu .mn.gui + .mn add cascade -label [__ "GUI"] -menu .mn.gui + + + if {[llength $::langs] > 1} { + menu .mn.gui.lang + .mn.gui add cascade -label [__ "Language"] -menu .mn.gui.lang + foreach l [lsort $::langs] { + if {$l eq $::lang} { + set mlabel "$l *" + } else { + set mlabel $l + } + .mn.gui.lang add command -label $mlabel -command "set_language $l" + } + } + + menu .mn.gui.fscale + .mn.gui add cascade -label [__ "Font scaling"] -menu .mn.gui.fscale + foreach s {0.5 0.7 1 1.25 1.5 2 3 4 6 8} { + if {$s eq $::tkfontscale} { + set mlabel "$s *" + } else { + set mlabel $s + } + .mn.gui.fscale add command -label $mlabel -command "set_fontscale $s" + } + + # wallpaper, for a uniform background pack [ttk::frame .bg -padding 3] -fill both -expand 1 # title |