texlive[54861] Master: Tcl GUIs: add browser shortcuts for font

[commits+siepo at tug.org]

Revision: 54861
          http://tug.org/svn/texlive?view=revision&revision=54861
Author:   siepo
Date:     2020-04-24 21:09:00 +0200 (Fri, 24 Apr 2020)
Log Message:
-----------
Tcl GUIs: add browser shortcuts  for font scaling

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

Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl	2020-04-24 18:47:01 UTC (rev 54860)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl	2020-04-24 19:09:00 UTC (rev 54861)
@@ -2010,6 +2010,11 @@
   }
 }
 
+proc zoom {n} {
+  if {$n <= 0} {set n 1}
+  set_fontscale [expr {$n*$::tkfontscale}]
+}
+
 ##### running external commands #####
 
 # For capturing an external command, we need a separate output channel,
@@ -2179,17 +2184,25 @@
   .mn.opt add cascade -label [__ "GUI font scaling"] \
       -menu .mn.opt.fscale
   menu .mn.opt.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.opt.fscale add command -label $mlabel \
-        -command "set_fontscale $s"
+  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"
   }
 
+  # browser-style keyboard shortcuts for scaling
+  bind . <Control-KeyRelease-minus> {zoom 0.8}
+  bind . <Control-KeyRelease-equal> {zoom 1.25}
+  bind . <Control-Shift-KeyRelease-equal> {zoom 1.25}
+  bind . <Control-KeyRelease-plus> {zoom 1.25}
+  bind . <Control-KeyRelease-0> {set_fontscale 1}
+  if {$::tcl_platform(os) eq "Darwin"} {
+    bind . <Command-KeyRelease-minus> {zoom 0.8}
+    bind . <Command-KeyRelease-equal> {zoom 1.25}
+    bind . <Command-Shift-KeyRelease-equal> {zoom 1.25}
+    bind . <Command-KeyRelease-plus> {zoom 1.25}
+    bind . <Command-KeyRelease-0> {set_fontscale 1}
+  }
 
+
   if {$::tcl_platform(platform) ne "windows"} {
     incr inx
     set ::inx_platforms $inx

Modified: trunk/Master/tlpkg/installer/install-tl-gui.tcl
===================================================================
--- trunk/Master/tlpkg/installer/install-tl-gui.tcl	2020-04-24 18:47:01 UTC (rev 54860)
+++ trunk/Master/tlpkg/installer/install-tl-gui.tcl	2020-04-24 19:09:00 UTC (rev 54861)
@@ -1319,6 +1319,11 @@
   run_menu
 }
 
+proc zoom {n} {
+  if {$n <= 0} {set n 1}
+  set_fontscale [expr {$n*$::tkfontscale}]
+}
+
 # menus: disable tearoff feature
 option add *Menu.tearOff 0
 
@@ -1394,15 +1399,24 @@
 
   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"
+  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"
   }
 
+  # browser-style keyboard shortcuts for scaling
+  bind . <Control-KeyRelease-minus> {zoom 0.8}
+  bind . <Control-KeyRelease-equal> {zoom 1.25}
+  bind . <Control-Shift-KeyRelease-equal> {zoom 1.25}
+  bind . <Control-KeyRelease-plus> {zoom 1.25}
+  bind . <Control-KeyRelease-0> {set_fontscale 1}
+  if {$::tcl_platform(os) eq "Darwin"} {
+    bind . <Command-KeyRelease-minus> {zoom 0.8}
+    bind . <Command-KeyRelease-equal> {zoom 1.25}
+    bind . <Command-Shift-KeyRelease-equal> {zoom 1.25}
+    bind . <Command-KeyRelease-plus> {zoom 1.25}
+    bind . <Command-KeyRelease-0> {set_fontscale 1}
+  }
+
   # wallpaper, for a uniform background
   pack [ttk::frame .bg -padding 3] -fill both -expand 1
 
@@ -2128,6 +2142,20 @@
     }
   }
   if {$answer eq "startinst"} {
+  # disable browser-style keyboard shortcuts for scaling
+    bind . <Control-KeyRelease-minus> {}
+    bind . <Control-KeyRelease-equal> {}
+    bind . <Control-Shift-KeyRelease-equal> {}
+    bind . <Control-KeyRelease-plus> {}
+    bind . <Control-KeyRelease-0> {}
+    if {$::tcl_platform(os) eq "Darwin"} {
+      bind . <Command-KeyRelease-minus> {}
+      bind . <Command-KeyRelease-equal> {}
+      bind . <Command-Shift-KeyRelease-equal> {}
+      bind . <Command-KeyRelease-plus> {}
+      bind . <Command-KeyRelease-0> {}
+    }
+
     run_installer
     # invokes show_log which first destroys previous children
   } else {