diff options
Diffstat (limited to 'Master/tlpkg')
-rwxr-xr-x | Master/tlpkg/installer/install-tl-gui.tcl | 99 | ||||
-rw-r--r-- | Master/tlpkg/tltcl/tltcl.tcl | 179 |
2 files changed, 204 insertions, 74 deletions
diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl index cd9001ea836..e831f8984be 100755 --- a/Master/tlpkg/installer/install-tl-gui.tcl +++ b/Master/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 diff --git a/Master/tlpkg/tltcl/tltcl.tcl b/Master/tlpkg/tltcl/tltcl.tcl index fdb9deef729..e95f919d7f1 100644 --- a/Master/tlpkg/tltcl/tltcl.tcl +++ b/Master/tlpkg/tltcl/tltcl.tcl @@ -205,8 +205,16 @@ normalize_argv # Otherwise, the localization code borrows much from Norbert Preining's # translation module for TL. -proc load_translations {} { +package require msgcat + +# available languages +set ::langs [list "en"] +foreach l [glob -nocomplain -directory \ + [file join $::instroot "tlpkg" "translations"] *.po] { + lappend ::langs [string range [file tail $l] 0 end-3] +} +proc initialize_language {} { # check the command-line for a lang parameter set ::lang "" set i 0 @@ -222,35 +230,17 @@ proc load_translations {} { } unset i - # First fallback: check config file. - # $TEXMFCONFIG/tlmgr/config can have a setting for gui-lang. - # There will not be one for the installer, only for tlmgr. - if {! [info exists ::lang] || $::lang eq ""} { - foreach tmf {"TEXMFCONFIG" "TEXMFSYSCONFIG"} { - if [catch {exec kpsewhich -var-value $tmf} d] { - break; # apparently there is not yet a TL installation - } - if [catch {open [file join $d "tlmgr" "config"] r} fid] continue - while 1 { - if [chan eof $fid] { - break - } - if [catch {chan gets $fid} l] break - if {[regexp {^\s*gui-lang\s*=\s*(\S+)$} $l m ::lang]} { - break - } - } - chan close $fid - if {[info exists ::lang] && $::lang ne ""} break - } + # First fallback, only for tlshell: check tlmgr config file + if {$::lang eq "" && [info exists ::invoker] && $::invoker eq "tlshell"} { + set ::lang [get_config_var "gui-lang"] } + # try to set tcltk's locale to $::lang too. this may not work for 8.5. + if {$::lang ne ""} {::msgcat::mclocale $::lang} + # second fallback: what does msgcat think about it? Note that # msgcat checks the environment and on windows also the registry. - if {! [info exists ::lang] || $::lang eq ""} { - package require msgcat - set ::lang [::msgcat::mclocale] - } + if {$::lang eq ""} {set ::lang [::msgcat::mclocale]} set messcat "" if {$::lang ne ""} { @@ -264,20 +254,29 @@ proc load_translations {} { set messcat $f break } elseif {[string range $ln_f 0 1] eq [string range $::lang 0 1]} { - set ::lang [string range $::lang 0 1] set maybe $f } } - if {$messcat eq ""} { - set messcat $maybe + if {$messcat eq "" && $maybe ne ""} { + set ::lang [string tolower [string range [file tail $maybe] 0 end-3]] } } +} +initialize_language +proc load_translations {} { + foreach s [array names ::TRANS] { + array unset ::TRANS $s + } + if {$::lang eq ""} return + set messcat [file join $::instroot "tlpkg" "translations" "${::lang}.po"] # parse messcat. - # for now, just skip lines which make no sense. - # empty messcat: no suitable message catalog - if {$messcat ne ""} { + # skip lines which make no sense + if [file exists $messcat] { # create array with msgid keys and msgstr values + # in the case that we switch languages, + # we need to remove old translations, + # since the new set may not completely cover the old one if {! [catch {open $messcat r} fid]} { fconfigure $fid -encoding utf-8 set inmsgid 0 @@ -340,6 +339,7 @@ proc load_translations {} { } } } +initialize_language load_translations proc __ {s args} { @@ -372,35 +372,96 @@ unset -nocomplain ::env(LANGUAGE) ### fonts ### -# no bold text for messages; `userDefault' indicates priority -option add *Dialog.msg.font TkDefaultFont userDefault - -# normal size bold -font create bfont {*}[font configure TkDefaultFont] -font configure bfont -weight bold -# larger, not bold: lfont -font create lfont {*}[font configure TkDefaultFont] -font configure lfont -size [expr {round(1.2 * [font actual lfont -size])}] -# larger and bold -font create hfont {*}[font configure lfont] -font configure hfont -weight bold -# extra large and bold -font create titlefont {*}[font configure TkDefaultFont] -font configure titlefont -weight bold \ - -size [expr {round(1.5 * [font actual titlefont -size])}] - -## italicized items; not used -#font create it_font {*}[font configure TkDefaultFont] -#font configure it_font -slant italic - -# width of '0', as a very rough estimate of average character width -set ::cw \ - [expr {max([font measure TkDefaultFont "0"],[font measure TkTextFont "0"])}] +# ttk defaults use TkDefaultFont and TkHeadingFont +# ttk classic theme also uses TkTextFont for TEntry +# ttk::combobox uses TkTextFont +# although only the first three appear to be used here, this may depend +# on the theme, so I resize all symbolic fonts anyway. + +set dflfonts [list \ + TkHeadingFont \ + TkCaptionFont \ + TkDefaultFont \ + TkMenuFont \ + TkTextFont \ + TkTooltipFont \ + TkFixedFont \ + TkIconFont \ + TkSmallCaptionFont \ +] +foreach f $::dflfonts { + set ::oldsize($f) [font configure $f -size] +} + +font create bfont +font create lfont +font create hfont +font create titlefont + +proc redo_fonts {} { + + # note that ttk styles refer to the above symbolic font names + # and generally do not define fonts themselves + + foreach f $::dflfonts { + font configure $f -size [expr { round($::oldsize($f)*$::tkfontscale)}] + } + # the above works for ttk::*button, ttk::treeview, notebook labels + unset -nocomplain f -# height: assume height == width*2 + option add *font TkDefaultFont + # the above works for menu items, ttk::label, text, ttk::entry + # including current value of ttk::combobox, ttk::combobox list items + # and non-ttk labels and buttons - which are not used here -# workaround for treeview on windows on HiDPI displays -ttk::style configure Treeview -rowheight [expr {3 * $::cw}] + set ::cw \ + [expr {max([font measure TkDefaultFont "0"],[font measure TkTextFont "0"])}] + # height: assume height == width*2 + # workaround for treeview on windows on HiDPI displays + ttk::style configure Treeview -rowheight [expr {3 * $::cw}] + + # no bold text for messages; `userDefault' indicates priority + option add *Dialog.msg.font TkDefaultFont userDefault + + # normal size bold + font configure bfont {*}[font configure TkDefaultFont] + font configure bfont -weight bold + # larger, not bold: lfont + font configure lfont {*}[font configure TkDefaultFont] + font configure lfont -size [expr {round(1.2 * [font actual lfont -size])}] + # larger and bold + font configure hfont {*}[font configure lfont] + font configure hfont -weight bold + # extra large and bold + font configure titlefont {*}[font configure TkDefaultFont] + font configure titlefont -weight bold \ + -size [expr {round(1.5 * [font actual titlefont -size])}] +} + +# initialize scaling factor + +set ::tkfontscale "" +if {[info exists ::invoker] && $::invoker eq "tlshell"} { + set ::tkfontscale [get_config_var "tkfontscale"] + # is $::tkfontscale a number, and a reasonable one? + if {[scan $::tkfontscale {%f} f] != 1} { ; # not a number + set ::tkfontscale "" + } elseif {$::tkfontscale < 0} { + set ::tkfontscale "" + } elseif {$::tkfontscale < 0.5} { + set ::tkfontscale 0.5 + } elseif {$::tkfontscale > 10} { + set ::tkfontscale 10 + } +} +if {$::tkfontscale eq ""} { + if {[winfo vrootheight .] > 2000 && [winfo vrootwidth .] > 3000} { + set ::tkfontscale 2 + } else { + set ::tkfontscale 1 + } +} +redo_fonts # icon catch { |