texlive[57711] Master: Tcl/Tk GUIs: better support for font scaling

commits+siepo at tug.org commits+siepo at tug.org
Thu Feb 11 14:09:50 CET 2021 

Revision: 57711
          http://tug.org/svn/texlive?view=revision&revision=57711
Author:   siepo
Date:     2021-02-11 14:09:50 +0100 (Thu, 11 Feb 2021)
Log Message:
-----------
Tcl/Tk GUIs: better support for font scaling and HiDPI

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
    trunk/Master/tlpkg/installer/install-tl-gui.tcl
    trunk/Master/tlpkg/tltcl/tltcl.tcl

Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl	2021-02-11 11:08:03 UTC (rev 57710)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl	2021-02-11 13:09:50 UTC (rev 57711)
@@ -2382,11 +2382,17 @@
   .mn.opt.paper add command -label "[__ "Advanced"] ..." \
       -command papersize_advanced
 
+
+  if {$::tcl_platform(platform) ne "windows"} {
+    incr inx
+    set ::inx_platforms $inx
+    .mn.opt add command -label "[__ "Platforms"] ..." -command platforms_select
+  }
+
   if {[llength $::langs] > 1} {
-    incr inx
-    .mn.opt add cascade -label [__ "GUI language"] \
-        -menu .mn.opt.lang
-    menu .mn.opt.lang
+    .mn add cascade -label [__ "GUI language"] \
+        -menu .mn.lang
+    menu .mn.lang
     foreach l [lsort $::langs] {
       if {$l eq $::lang} {
         set mlabel "$l *"
@@ -2393,19 +2399,18 @@
       } 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 @@
     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

Modified: trunk/Master/tlpkg/installer/install-tl-gui.tcl
===================================================================
--- trunk/Master/tlpkg/installer/install-tl-gui.tcl	2021-02-11 11:08:03 UTC (rev 57710)
+++ trunk/Master/tlpkg/installer/install-tl-gui.tcl	2021-02-11 13:09:50 UTC (rev 57711)
@@ -307,7 +307,7 @@
   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 @@
   }
 
   # 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 @@
   }
 
   # 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 @@
   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 @@
   }
 }; # log_exit
 
-#############################################################
-
-##########################################################
-
 ##### installation root #####
 
 proc update_full_path {} {
@@ -521,14 +517,14 @@
   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 @@
       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 @@
   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 @@
   }
 
   # 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 @@
   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 @@
   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 @@
   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 @@
   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 @@
     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 @@
     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,20 +1368,15 @@
   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"]
+  .mn 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
+    menu .mn.lang
+    .mn add cascade -label [__ "Language"] -menu .mn.lang
     foreach l [lsort $::langs] {
       if {$l eq $::lang} {
         set mlabel "$l *"
@@ -1392,16 +1383,16 @@
       } 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 @@
   }
 
   # 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 @@
     }] -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 @@
   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 @@
   }
 
   # 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 @@
   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 @@
     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 @@
 
   # 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"
   }

Modified: trunk/Master/tlpkg/tltcl/tltcl.tcl
===================================================================
--- trunk/Master/tlpkg/tltcl/tltcl.tcl	2021-02-11 11:08:03 UTC (rev 57710)
+++ trunk/Master/tlpkg/tltcl/tltcl.tcl	2021-02-11 13:09:50 UTC (rev 57711)
@@ -454,13 +454,10 @@
     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

More information about the tex-live-commits mailing list.