From d7d0ec4e593088fe318f1e657d64e8f68c708cbd Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 Apr 2009 10:16:24 +0000 Subject: Fix [Bug 2116837]. --- ChangeLog | 5 +++ library/tk.tcl | 100 ++++++++++++++++++++++++++++++++++----------------------- 2 files changed, 64 insertions(+), 41 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2b40cbd..32f055a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2009-04-10 Donal K. Fellows + + * library/tk.tcl: [Bug 2116837]: Add event definitions to handle the + standard virtual events when Caps Lock is on. + 2009-04-08 Donal K. Fellows * library/demos/widget (addFormattedText): Stop marking demonstrations diff --git a/library/tk.tcl b/library/tk.tcl index 6299d01..3a31128 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.83 2009/01/16 20:55:12 dgp Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.84 2009/04/10 10:16:24 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -26,7 +26,7 @@ namespace eval ::tk { # The msgcat package is not available. Supply our own # minimal replacement. proc mc {src args} { - return [format $src {*}$args] + tailcall format $src {*}$args } proc mcmax {args} { set max 0 @@ -59,7 +59,8 @@ namespace eval ::ttk { # isn't already on the path: if {[info exists ::auto_path] && ($::tk_library ne "") - && ($::tk_library ni $::auto_path)} { + && ($::tk_library ni $::auto_path) +} then { lappend ::auto_path $::tk_library $::ttk::library } @@ -129,7 +130,9 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } if {[tk windowingsystem] eq "aqua"} { # Avoid the native menu bar which sits on top of everything. - if {$y < 22} { set y 22 } + if {$y < 22} { + set y 22 + } } } wm geometry $w +$x+$y @@ -210,9 +213,11 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { # if {$tcl_platform(platform) eq "unix"} { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel \ - -type UTF8_STRING} txt] \ - && [catch {selection get -displayof $w -selection $sel} txt]} { + if {[catch { + selection get -displayof $w -selection $sel -type UTF8_STRING + } txt] && [catch { + selection get -displayof $w -selection $sel + } txt]} then { return -code error "could not find default selection" } else { return $txt @@ -220,7 +225,9 @@ if {$tcl_platform(platform) eq "unix"} { } } else { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel} txt]} { + if {[catch { + selection get -displayof $w -selection $sel + } txt]} then { return -code error "could not find default selection" } else { return $txt @@ -317,35 +324,35 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { if {![llength [info commands tk_chooseColor]]} { proc ::tk_chooseColor {args} { - return [tk::dialog::color:: {*}$args] + tailcall ::tk::dialog::color:: {*}$args } } if {![llength [info commands tk_getOpenFile]]} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog open {*}$args] + tailcall ::tk::MotifFDialog open {*}$args } else { - return [::tk::dialog::file:: open {*}$args] + tailcall ::tk::dialog::file:: open {*}$args } } } if {![llength [info commands tk_getSaveFile]]} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog save {*}$args] + tailcall ::tk::MotifFDialog save {*}$args } else { - return [::tk::dialog::file:: save {*}$args] + tailcall ::tk::dialog::file:: save {*}$args } } } if {![llength [info commands tk_messageBox]]} { proc ::tk_messageBox {args} { - return [tk::MessageBox {*}$args] + tailcall ::tk::MessageBox {*}$args } } if {![llength [info command tk_chooseDirectory]]} { proc ::tk_chooseDirectory {args} { - return [::tk::dialog::file::chooseDir:: {*}$args] + tailcall ::tk::dialog::file::chooseDir:: {*}$args } } @@ -355,17 +362,22 @@ if {![llength [info command tk_chooseDirectory]]} { switch -exact -- [tk windowingsystem] { "x11" { - event add <> - event add <> - event add <> + event add <> + event add <> + event add <> event add <> - event add <> - event add <> - # Some OS's define a goofy (as in, not ) keysym - # that is returned when the user presses . In order for - # tab traversal to work, we have to add these keysyms to the - # PrevWindow event. - # We use catch just in case the keysym isn't recognized. + event add <> + event add <> + event add <> + if {$tk_platform(os) eq "Darwin"} { + event add <> + } + + # Some OS's define a goofy (as in, not ) keysym that is + # returned when the user presses . In order for tab + # traversal to work, we have to add these keysyms to the PrevWindow + # event. We use catch just in case the keysym isn't recognized. + # This is needed for XFree86 systems catch { event add <> } # This seems to be correct on *some* HP systems. @@ -378,21 +390,26 @@ switch -exact -- [tk windowingsystem] { set ::tk::AlwaysShowSelection 1 } "win32" { - event add <> - event add <> - event add <> + event add <> \ + + event add <> \ + + event add <> \ + event add <> - event add <> - event add <> + event add <> + event add <> + event add <> } "aqua" { - event add <> - event add <> - event add <> + event add <> + event add <> + event add <> event add <> event add <> - event add <> - event add <> + event add <> + event add <> + event add <> } } # ---------------------------------------------------------------------- @@ -421,7 +438,8 @@ if {$::tk_library ne ""} { # ---------------------------------------------------------------------- event add <> -bind all {tk::TabToWindow [tk_focusNext %W]} +event add <> +bind all <> {tk::TabToWindow [tk_focusNext %W]} bind all <> {tk::TabToWindow [tk_focusPrev %W]} # ::tk::CancelRepeat -- @@ -473,10 +491,9 @@ proc ::tk::UnderlineAmpersand {text} { set idx [string first "&" [string range $text $base end]] if {$idx < 0} { break - } else { - set underline [expr {$underline + $idx + 1}] - incr idx $base } + set underline [expr {$underline + $idx + 1}] + incr idx $base } } if {$idx >= 0} { @@ -566,8 +583,9 @@ proc ::tk::FindAltKeyTarget {path char} { # proc ::tk::AltKeyInDialog {path key} { set target [FindAltKeyTarget $path $key] - if { $target eq ""} return - event generate $target <> + if {$target ne ""} { + event generate $target <> + } } # ::tk::mcmaxamp -- -- cgit v0.12