From e0e2537ccbac6924b371be81092c1177e817162c Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 22 Apr 2020 03:02:46 +0000 Subject: CTAN sync 202004220302 --- systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl | 179 +++++++++++++++++++--------- 1 file changed, 120 insertions(+), 59 deletions(-) (limited to 'systems/texlive/tlnet/tlpkg/tltcl') diff --git a/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl b/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl index fdb9deef72..e95f919d7f 100644 --- a/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl +++ b/systems/texlive/tlnet/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 { -- cgit v1.2.3