summaryrefslogtreecommitdiff
path: root/Master/tlpkg
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2020-04-21 11:51:02 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2020-04-21 11:51:02 +0000
commite783b071ded7eef421d0333416b47142bc5542cb (patch)
tree373aa750749416f23bbfbd35136cf8a6b5fe9d41 /Master/tlpkg
parentbc8d7784445ea47de3f2b5f07f9cd3297562130d (diff)
GUI font scaling; change language and font size on the fly
git-svn-id: svn://tug.org/texlive/trunk@54823 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg')
-rwxr-xr-xMaster/tlpkg/installer/install-tl-gui.tcl99
-rw-r--r--Master/tlpkg/tltcl/tltcl.tcl179
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 {