From 6cf0c8fdcd4d02efd21775c85e46d84e07194b7a Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 11 Feb 2021 13:09:50 +0000 Subject: Tcl/Tk GUIs: better support for font scaling and HiDPI git-svn-id: svn://tug.org/texlive/trunk@57711 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/installer/install-tl-gui.tcl | 92 ++++++++++++++----------------- 1 file changed, 40 insertions(+), 52 deletions(-) (limited to 'Master/tlpkg/installer/install-tl-gui.tcl') 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 {.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" } -- cgit v1.2.3