summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2021-02-11 13:09:50 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2021-02-11 13:09:50 +0000
commit6cf0c8fdcd4d02efd21775c85e46d84e07194b7a (patch)
tree328ad542f5f9b93656f8ede14cff486aff085663
parentbafb328203deff338e0b786a80dc845208cb3392 (diff)
Tcl/Tk GUIs: better support for font scaling and HiDPI
git-svn-id: svn://tug.org/texlive/trunk@57711 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-xMaster/texmf-dist/scripts/tlshell/tlshell.tcl34
-rwxr-xr-xMaster/tlpkg/installer/install-tl-gui.tcl92
-rw-r--r--Master/tlpkg/tltcl/tltcl.tcl11
3 files changed, 60 insertions, 77 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index c6403865704..50f863e6084 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -2382,30 +2382,35 @@ proc populate_main {} {
.mn.opt.paper add command -label "[__ "Advanced"] ..." \
-command papersize_advanced
- if {[llength $::langs] > 1} {
+
+ if {$::tcl_platform(platform) ne "windows"} {
incr inx
- .mn.opt add cascade -label [__ "GUI language"] \
- -menu .mn.opt.lang
- menu .mn.opt.lang
+ set ::inx_platforms $inx
+ .mn.opt add command -label "[__ "Platforms"] ..." -command platforms_select
+ }
+
+ if {[llength $::langs] > 1} {
+ .mn add cascade -label [__ "GUI language"] \
+ -menu .mn.lang
+ menu .mn.lang
foreach l [lsort $::langs] {
if {$l eq $::lang} {
set mlabel "$l *"
} else {
set mlabel $l
}
- .mn.opt.lang add command -label $mlabel \
+ .mn.lang add command -label $mlabel \
-command "set_language $l"
}
}
- incr inx
- .mn.opt add cascade -label [__ "GUI font scaling"] \
- -menu .mn.opt.fscale
- menu .mn.opt.fscale
- .mn.opt.fscale add command -label \
+ .mn add cascade -label [__ "GUI font scaling"] \
+ -menu .mn.fscale
+ menu .mn.fscale
+ .mn.fscale add command -label \
"[__ "Current"]: [format {%.2f} $::tkfontscale]"
foreach s {0.6 0.8 1 1.2 1.6 2 2.5 3 3.8 5 6 7.5 9} {
- .mn.opt.fscale add command -label $s -command "set_fontscale $s"
+ .mn.fscale add command -label $s -command "set_fontscale $s"
}
# browser-style keyboard shortcuts for scaling
@@ -2422,13 +2427,6 @@ proc populate_main {} {
bind . <Command-KeyRelease-0> {set_fontscale 1}
}
-
- if {$::tcl_platform(platform) ne "windows"} {
- incr inx
- set ::inx_platforms $inx
- .mn.opt add command -label "[__ "Platforms"] ..." -command platforms_select
- }
-
.mn add cascade -label [__ "Help"] -menu .mn.help -underline 0
menu .mn.help
.mn.help add command -label [__ "About"] -command about_cmd
diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl
index e962feb7c61..34c4de70602 100755
--- a/Master/tlpkg/installer/install-tl-gui.tcl
+++ b/Master/tlpkg/installer/install-tl-gui.tcl
@@ -307,7 +307,7 @@ proc replace_repo_parameter {m} {
while {$i > 0} {
incr i -1
set p [lindex $::argv $i]
- if {$p in [list "-location" "-url" "-repository" "-repos" "-repo"]} {
+ if {$p in {"-location" "-url" "-repository" "-repos" "-repo"}} {
set j [expr {$i+1}]
if {$j < [llength $::argv]} {
set ::argv [lreplace $::argv $i $j]
@@ -380,7 +380,7 @@ proc pre_splash {} {
}
# wallpaper for remaining widgets
- pack [ttk::frame .bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .bg -padding 3pt] -fill both -expand 1
# frame for buttons (abort button, mirrors dropdown menu)
pack [ttk::frame .splfb] -in .bg -side bottom -fill x
@@ -435,7 +435,7 @@ proc show_log {{do_abort 0}} {
}
# wallpaper
- pack [ttk::frame .bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .bg -padding 3pt] -fill both -expand 1
# buttons at bottom
pack [ttk::frame .bottom] -in .bg -side bottom -fill x
@@ -453,7 +453,7 @@ proc show_log {{do_abort 0}} {
pack [ttk::frame .log] -in .bg -fill both -expand 1
pack [ttk::scrollbar .log.scroll -command ".log.tx yview"] \
-side right -fill y
- ppack [text .log.tx -height 10 -wrap word -font TkDefaultFont \
+ ppack [text .log.tx -height 20 -wrap word -font TkDefaultFont \
-yscrollcommand ".log.scroll set"] \
-expand 1 -fill both
.log.tx configure -state normal
@@ -486,10 +486,6 @@ proc log_exit {{mess ""}} {
}
}; # log_exit
-#############################################################
-
-##########################################################
-
##### installation root #####
proc update_full_path {} {
@@ -521,14 +517,14 @@ proc edit_name {} {
if $::plain_unix {wm attributes .tled -type dialog}
# wallpaper
- pack [ttk::frame .tled.bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .tled.bg -padding 3pt] -fill both -expand 1
# widgets
ttk::label .tled.l -text [__ "Change name (slashes not allowed)"]
- pack .tled.l -in .tled.bg -padx 5 -pady 5
+ pack .tled.l -in .tled.bg -padx 5pt -pady 5pt
ttk::entry .tled.e -width 20
.tled.e state !disabled
- pack .tled.e -in .tled.bg -pady 5
+ pack .tled.e -in .tled.bg -pady 5pt
.tled.e insert 0 [.tltd.name_l cget -text]
# now frame with ok and cancel buttons
@@ -542,9 +538,9 @@ proc edit_name {} {
end_dlg "" .tled
}
}
- ppack .tled.ok_b -in .tled.buttons -side right -padx 5 -pady 5
+ ppack .tled.ok_b -in .tled.buttons -side right -padx 5pt -pady 5pt
ttk::button .tled.cancel_b -text [__ "Cancel"] -command {end_dlg "" .tled}
- ppack .tled.cancel_b -in .tled.buttons -side right -padx 5 -pady 5
+ ppack .tled.cancel_b -in .tled.buttons -side right -padx 5pt -pady 5pt
bind .tled <Escape> {.tled.cancel_b invoke}
wm protocol .tled WM_DELETE_WINDOW \
@@ -619,14 +615,14 @@ proc texdir_setup {} {
wm title .tltd [__ "Installation root"]
# wallpaper
- pack [ttk::frame .tltd.bg -padding 3] -expand 1 -fill both
+ pack [ttk::frame .tltd.bg -padding 3pt] -expand 1 -fill both
# full path
pack [ttk::label .tltd.path_l -font lfont -anchor center] \
- -in .tltd.bg -pady 10 -fill x -expand 1
+ -in .tltd.bg -pady 10pt -fill x -expand 1
# installation root components, gridded
- pack [ttk::frame .tltd.fr1 -borderwidth 2 -relief groove] \
+ pack [ttk::frame .tltd.fr1 -borderwidth 2pt -relief groove] \
-in .tltd.bg -fill x -expand 1
grid columnconfigure .tltd.fr1 0 -weight 1
grid columnconfigure .tltd.fr1 2 -weight 1
@@ -662,7 +658,7 @@ proc texdir_setup {} {
}
# ok/cancel buttons
- pack [ttk::frame .tltd.frbt] -in .tltd.bg -pady [list 10 0] -fill x
+ pack [ttk::frame .tltd.frbt] -in .tltd.bg -pady {10pt 0pt} -fill x
ttk::button .tltd.ok_b -text [__ "Ok"] -command commit_root
ppack .tltd.ok_b -in .tltd.frbt -side right
ttk::button .tltd.cancel_b -text [__ "Cancel"] \
@@ -726,7 +722,7 @@ proc edit_dir {d} {
if $::plain_unix {wm attributes .td -type dialog}
# wallpaper
- pack [ttk::frame .td.bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .td.bg -padding 3pt] -fill both -expand 1
if {$d eq "TEXMFHOME"} {
# explain tilde
@@ -931,7 +927,7 @@ proc select_binaries {} {
wm title .tlbin [__ "Binaries"]
# wallpaper
- pack [ttk::frame .tlbin.bg -padding 3] -expand 1 -fill both
+ pack [ttk::frame .tlbin.bg -padding 3pt] -expand 1 -fill both
# ok, cancel buttons
pack [ttk::frame .tlbin.buts] -in .tlbin.bg -side bottom -fill x
@@ -980,7 +976,7 @@ proc select_scheme {} {
wm title .tlschm [__ "Schemes"]
# wallpaper
- pack [ttk::frame .tlschm.bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .tlschm.bg -padding 3pt] -fill both -expand 1
# buttons at bottom
pack [ttk::frame .tlschm.buts] -in .tlschm.bg -side bottom -fill x
@@ -1068,7 +1064,7 @@ proc select_collections {} {
wm title .tlcoll [__ "Collections"]
# wallpaper
- pack [ttk::frame .tlcoll.bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .tlcoll.bg -padding 3pt] -fill both -expand 1
# frame at bottom with ok and cancel buttons
pack [ttk::frame .tlcoll.butf] -in .tlcoll.bg -side bottom -fill x
@@ -1088,14 +1084,14 @@ proc select_collections {} {
set wgb .tlcoll.b$t
ttk::frame $wgb
ttk::label ${wgb}sel -text [__ "Select"]
- ttk::button ${wgb}all -text [__ "All"] -padding 1 -command \
+ ttk::button ${wgb}all -text [__ "All"] -padding 1pt -command \
"foreach c \[.tlcoll.$t children {}\] \{
.tlcoll.$t set \$c mk \[mark_sym 1\]\}"
- ttk::button ${wgb}none -text [__ "None"] -padding 1 -command \
+ ttk::button ${wgb}none -text [__ "None"] -padding 1pt -command \
"foreach c \[.tlcoll.$t children {}\] \{
.tlcoll.$t set \$c mk \[mark_sym 0\]\}"
pack ${wgb}sel ${wgb}all ${wgb}none -in $wgb \
- -side left -padx 3 -pady 3
+ -side left -padx 3pt -pady 3pt
# trees with collections and markers, lang and other separately
set wgt ".tlcoll.$t"
@@ -1252,7 +1248,7 @@ if {$::tcl_platform(platform) ne "windows"} {
create_dlg .edsyms .
wm title .edsyms [__ "Symlinks"]
- pack [ttk::frame .edsyms.bg -padding 3] -expand 1 -fill both
+ pack [ttk::frame .edsyms.bg -padding 3pt] -expand 1 -fill both
set rw -1
pack [ttk::frame .edsyms.fr0] -in .edsyms.bg -expand 1 -fill both
@@ -1372,36 +1368,31 @@ proc run_menu {} {
menu .mn
. configure -menu .mn
if $::plain_unix {
- .mn configure -borderwidth 1
+ .mn configure -borderwidth 1pt
.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
+ .mn add command -command abort_menu -label [__ "Abort"]
if {[llength $::langs] > 1} {
- menu .mn.gui.lang
- .mn.gui add cascade -label [__ "Language"] -menu .mn.gui.lang
+ menu .mn.lang
+ .mn add cascade -label [__ "Language"] -menu .mn.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"
+ .mn.lang add command -label $mlabel -command "set_language $l"
}
}
- menu .mn.gui.fscale
- .mn.gui add cascade -label [__ "Font scaling"] -menu .mn.gui.fscale
- .mn.gui.fscale add command -label \
- "Current: [format {%.2f} $::tkfontscale]"
+ menu .mn.fscale
+ .mn add cascade -label [__ "Font scaling"] -menu .mn.fscale
+ .mn.fscale add command -label \
+ [__ "Current" [format {: %.2f} $::tkfontscale]]
foreach s {0.6 0.8 1 1.2 1.6 2 2.5 3 3.8 5 6 7.5 9} {
- .mn.gui.fscale add command -label $s -command "set_fontscale $s"
+ .mn.fscale add command -label $s -command "set_fontscale $s"
}
# browser-style keyboard shortcuts for scaling
@@ -1419,20 +1410,20 @@ proc run_menu {} {
}
# wallpaper, for a uniform background
- pack [ttk::frame .bg -padding 3] -fill both -expand 1
+ pack [ttk::frame .bg -padding 3pt] -fill both -expand 1
# title
ttk::label .title -text [__ "TeX Live %s Installer" $::release_year] \
-font titlefont
- pack .title -pady {10 1} -in .bg
+ pack .title -pady {10pt 1pt} -in .bg
pack [ttk::label .svn -text "r. $::svn"] -in .bg
pack [ttk::separator .seph0 -orient horizontal] \
- -in .bg -pady 3 -fill x
+ -in .bg -pady 3pt -fill x
# frame at bottom with install/quit buttons
pack [ttk::frame .final] \
- -in .bg -side bottom -pady [list 5 2] -fill x
+ -in .bg -side bottom -pady {5pt 2pt} -fill x
ppack [ttk::button .install -text [__ "Install"] -command {
set ::menu_ans "startinst"}] -in .final -side right
ppack [ttk::button .quit -text [__ "Quit"] -command {
@@ -1446,7 +1437,7 @@ proc run_menu {} {
}] -in .final -side left
}
pack [ttk::separator .seph1 -orient horizontal] \
- -in .bg -side bottom -pady 3 -fill x
+ -in .bg -side bottom -pady 3pt -fill x
# directories, selections
# advanced and basic have different frame setups
@@ -1635,7 +1626,7 @@ proc run_menu {} {
if $::advanced {
pack [ttk::separator .sepv -orient vertical] \
- -in .bg -side left -padx 3 -fill y
+ -in .bg -side left -padx 3pt -fill y
pack [ttk::frame .options] -in .bg -side right -fill both -expand 1
set curf .options
@@ -1650,7 +1641,7 @@ proc run_menu {} {
}
# instopt_letter
- set ::lpapers [list "A4" "letter"]
+ set ::lpapers {"A4" "letter"}
incr rw
pgrid [ttk::label .paperl -text [__ "Default paper size"]] \
-in $curf -row $rw -column 0 -sticky w
@@ -1995,8 +1986,6 @@ proc main_prog {} {
wm title . [__ "TeX Live Installer"]
wm protocol . WM_DELETE_WINDOW whataboutclose
- if {[file exists $::dblfile]} {file delete $::dblfile}
-
# handle some command-line arguments.
# the argument list should already be normalized: '--' => '-', "=" => ' '
set ::prelocation "..."
@@ -2007,7 +1996,7 @@ proc main_prog {} {
set iplus $i
incr i -1
set p [lindex $::argv $i]
- if {$p in [list "-location" "-url" "-repository" "-repos" "-repo"]} {
+ if {$p in {"-location" "-url" "-repository" "-repos" "-repo"}} {
# check for repository argument: bail out if obviously invalid
if {$iplus<$l} {
set p [lindex $::argv $iplus]
@@ -2038,8 +2027,7 @@ proc main_prog {} {
# start install-tl-[tcl] via a pipe.
set cmd [list "|${::perlbin}" "${::instroot}/install-tl" \
- "-from_ext_gui" {*}$::argv 2>@1]
- #show_time "opening pipe"
+ "-from_ext_gui" {*}$::argv "2>@1"]
if [catch {open $cmd r+} ::inst] {
err_exit "Error starting Perl backend"
}
diff --git a/Master/tlpkg/tltcl/tltcl.tcl b/Master/tlpkg/tltcl/tltcl.tcl
index 562b148125e..6c673ddee3f 100644
--- a/Master/tlpkg/tltcl/tltcl.tcl
+++ b/Master/tlpkg/tltcl/tltcl.tcl
@@ -454,13 +454,10 @@ if {[info exists ::invoker] && $::invoker eq "tlshell"} {
set ::tkfontscale 10
}
}
-if {$::tkfontscale eq ""} {
- if {[winfo vrootheight .] > 2000 && [winfo vrootwidth .] > 3000} {
- set ::tkfontscale 2
- } else {
- set ::tkfontscale 1
- }
-}
+# most systems with a HiDPI display will be configured for it.
+# set therefore the default simply to 1.
+# users still have the option to scale fonts via the menu.
+if {$::tkfontscale eq ""} {set ::tkfontscale 1}
redo_fonts
# icon