From 4af4b242bba3b66fc9db8237966ca8e90d26c094 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 24 Sep 2021 15:01:44 +0000 Subject: Make IME bindings not leak into global variables --- library/entry.tcl | 23 ++++++++--- library/menu.tcl | 6 ++- library/print.tcl | 4 +- library/text.tcl | 26 +++++++++--- library/ttk/entry.tcl | 13 ++++++ library/ttk/fonts.tcl | 107 ++++++++++++++++++++++++-------------------------- 6 files changed, 108 insertions(+), 71 deletions(-) diff --git a/library/entry.tcl b/library/entry.tcl index 99f6eb4..1af9e65 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -276,11 +276,7 @@ bind Entry <> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Entry <> { - if {[catch {dict get $::tk::Priv(IMETextMark) "%W"} mark]} { - bell - } else { - %W selection range $mark insert - } + ::tk::EntryEndIMEMarkedText %W } bind Entry <> { %W delete [dict get $::tk::Priv(IMETextMark) "%W"] [%W index insert] @@ -289,6 +285,23 @@ bind Entry <> { tk::EntryBackspace %W } +# ::tk::EntryEndIMEMarkedText -- +# Handles input method text marking in an entry +# +# Arguments: +# w - The entry window. + +proc ::tk::EntryEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w selection range $mark insert +} + # A few additional bindings of my own. bind Entry { diff --git a/library/menu.tcl b/library/menu.tcl index 75e173d..7875afe 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -497,10 +497,12 @@ proc ::tk::MenuMotion {menu x y state} { # Catch these postcascade commands since the menu could be # destroyed before they run. set Priv(menuActivatedTimer) \ - [after $delay "catch {$menu postcascade active}"] + [after $delay [list catch [list \ + $menu postcascade active]]] } else { set Priv(menuDeactivatedTimer) \ - [after $delay "catch {$menu postcascade none}"] + [after $delay [list catch [list + $menu postcascade none]]] } } } diff --git a/library/print.tcl b/library/print.tcl index 7820a5f..1c2fd20 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -676,8 +676,8 @@ namespace eval ::tk::print { for your system." return } - set notfound "No destinations added" - if {[string first $notfound $msg] != -1} { + set notfound "No destinations added" + if {[string first $notfound $msg] != -1} { error "Please check or update your CUPS installation." return } diff --git a/library/text.tcl b/library/text.tcl index 9af3816..795a1d3 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -395,12 +395,7 @@ bind Text <> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Text <> { - if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } { - bell - } else { - %W tag add IMEmarkedtext $mark insert - %W tag configure IMEmarkedtext -underline on - } + ::tk::TextEndIMEMarkedText %W } bind Text <> { %W delete IMEmarkedtext.first IMEmarkedtext.last @@ -409,6 +404,25 @@ bind Text <> { %W delete insert-1c } +# ::tk::TextEndIMEMarkedText -- +# +# Handles input method text marking in a text widget. +# +# Arguments: +# w - The text widget + +proc ::tk::TextEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w tag add IMEmarkedtext $mark insert + $w tag configure IMEmarkedtext -underline on +} + # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index fb49055..f10c194 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -161,6 +161,19 @@ bind TEntry <> { ttk::entry::Backspace %W } +## EndIMEMarkedText -- Handle the end of input method selection. +# +proc ::ttk::entry::EndIMEMarkedText {w} { + variable ::tk::Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w selection range $mark insert +} + ### Clipboard procedures. # diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index 65f2c5e..2526fac 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -66,87 +66,82 @@ catch {font create TkIconFont} catch {font create TkMenuFont} catch {font create TkSmallCaptionFont} -if {!$tip145} { -variable F ;# miscellaneous platform-specific font parameters +if {!$tip145} {apply {{} { +global tcl_platform switch -- [tk windowingsystem] { win32 { # In safe interps there is no osVersion element. if {[info exists tcl_platform(osVersion)]} { if {$tcl_platform(osVersion) >= 5.0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } else { if {[lsearch -exact [font families] Tahoma] >= 0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } - set F(size) 8 + set size 8 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(size) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $size font configure TkFixedFont -family Courier -size 10 - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(size) + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $size } aqua { - set F(family) "Lucida Grande" - set F(fixed) "Monaco" - set F(menusize) 14 - set F(size) 13 - set F(viewsize) 12 - set F(smallsize) 11 - set F(labelsize) 10 - set F(fixedsize) 11 + set family "Lucida Grande" + set fixed "Monaco" + set menusize 14 + set size 13 + set viewsize 12 + set smallsize 11 + set labelsize 10 + set fixedsize 11 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(smallsize) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(smallsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(menusize) - font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $smallsize + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $smallsize + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $menusize + font configure TkSmallCaptionFont -family $family -size $labelsize } default - x11 { - if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} { - set F(family) "sans-serif" - set F(fixed) "monospace" + if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} { + set family "sans-serif" + set fixed "monospace" } else { - set F(family) "Helvetica" - set F(fixed) "courier" + set family "Helvetica" + set fixed "courier" } - set F(size) 10 - set F(ttsize) 9 - set F(capsize) 12 - set F(fixedsize) 10 + set size 10 + set ttsize 9 + set capsize 12 + set fixedsize 10 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkCaptionFont -family $F(family) -size $F(capsize) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(ttsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(ttsize) + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size -weight bold + font configure TkCaptionFont -family $family -size $capsize -weight bold + font configure TkTooltipFont -family $family -size $ttsize + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $ttsize } } -unset -nocomplain F -} +} ::ttk}} } -- cgit v0.12