From 890d36fd2065fa3e1fd8cadcfac6013dbc1e7b62 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 28 Mar 2011 21:10:05 +0000 Subject: Make tk::FindAltKeyTarget handle the traversal of the logical window manager hierarchy correctly. Based on comments by Emiliano Gavilan. --- ChangeLog | 13 ++++++++--- library/tk.tcl | 69 +++++++++++++++++++++++++++++++--------------------------- 2 files changed, 47 insertions(+), 35 deletions(-) diff --git a/ChangeLog b/ChangeLog index 459e3b7..c4be78e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,11 +1,18 @@ +2011-03-28 Donal K. Fellows + + * library/tk.tcl (::tk::FindAltKeyTarget): Make this handle the + traversal of the logical window manager hierarchy correctly. Based on + comments by Emiliano Gavilan. + 2011-03-28 Jan Nijtmans - * generic/tkTextBTree.c: [Bug 3129527]: Fix buffer overflow w/ GCC 4.5 and - -D_FORTIFY_SOURCE=2. One more place where this problem could appear. + * generic/tkTextBTree.c: [Bug 3129527]: Fix buffer overflow w/ GCC 4.5 + and -D_FORTIFY_SOURCE=2. One more place where this problem could + appear. 2011-03-24 Jan Nijtmans - * win/tkWinMenu.c: [Bug #3239768] tk8.4.19 (and later) WIN32 + * win/tkWinMenu.c: [Bug #3239768]: tk8.4.19 (and later) WIN32 menu font support. 2011-03-16 Jan Nijtmans diff --git a/library/tk.tcl b/library/tk.tcl index 59538f5..71afb6e 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -522,10 +522,10 @@ proc ::tk::TabToWindow {w} { } # ::tk::UnderlineAmpersand -- -# This procedure takes some text with ampersand and returns -# text w/o ampersand and position of the ampersand. -# Double ampersands are converted to single ones. -# Position returned is -1 when there is no ampersand. +# This procedure takes some text with ampersand and returns text w/o +# ampersand and position of the ampersand. Double ampersands are +# converted to single ones. Position returned is -1 when there is no +# ampersand. # proc ::tk::UnderlineAmpersand {text} { set s [string map {&& & & \ufeff} $text] @@ -534,8 +534,8 @@ proc ::tk::UnderlineAmpersand {text} { } # ::tk::SetAmpText -- -# Given widget path and text with "magic ampersands", -# sets -text and -underline options for the widget +# Given widget path and text with "magic ampersands", sets -text and +# -underline options for the widget # proc ::tk::SetAmpText {widget text} { lassign [UnderlineAmpersand $text] newtext under @@ -543,8 +543,8 @@ proc ::tk::SetAmpText {widget text} { } # ::tk::AmpWidget -- -# Creates new widget, turning -text option into -text and -# -underline options, returned by ::tk::UnderlineAmpersand. +# Creates new widget, turning -text option into -text and -underline +# options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpWidget {class path args} { set options {} @@ -564,8 +564,8 @@ proc ::tk::AmpWidget {class path args} { } # ::tk::AmpMenuArgs -- -# Processes arguments for a menu entry, turning -label option into -# -label and -underline options, returned by ::tk::UnderlineAmpersand. +# Processes arguments for a menu entry, turning -label option into +# -label and -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpMenuArgs {widget add type args} { set options {} @@ -581,36 +581,41 @@ proc ::tk::AmpMenuArgs {widget add type args} { } # ::tk::FindAltKeyTarget -- -# search recursively through the hierarchy of visible widgets -# to find button or label which has $char as underlined character +# Search recursively through the hierarchy of visible widgets to find +# button or label which has $char as underlined character. # proc ::tk::FindAltKeyTarget {path char} { - switch -- [winfo class $path] { - Button - Label - - TButton - TLabel - TCheckbutton { - if {[string equal -nocase $char \ - [string index [$path cget -text] [$path cget -underline]]]} { - return $path - } else { - return {} + set class [winfo class $path] + if {$class in { + Button Checkbutton Label Radiobutton + TButton TCheckbutton TLabel TRadiobutton + } && [string equal -nocase $char \ + [string index [$path cget -text] [$path cget -underline]]]} { + return $path + } + set subwins [concat [grid slaves $path] [pack slaves $path] \ + [place slaves $path]] + if {$class eq "Canvas"} { + foreach item [$path find all] { + if {[$path type $item] eq "window"} { + set w [$path itemcget $item -window] + if {$w ne ""} {lappend subwins $w} } } - default { - foreach child [concat [grid slaves $path] \ - [pack slaves $path] [place slaves $path]] { - set target [FindAltKeyTarget $child $char] - if {$target ne ""} { - return $target - } - } + } elseif {$class eq "Text"} { + lappend subwins {*}[$path window names] + } + foreach child $subwins { + set target [FindAltKeyTarget $child $char] + if {$target ne ""} { + return $target } } - return {} } # ::tk::AltKeyInDialog -- -# event handler for standard dialogs. Sends <> -# to button or label which has appropriate underlined character +# event handler for standard dialogs. Sends <> +# to button or label which has appropriate underlined character. # proc ::tk::AltKeyInDialog {path key} { set target [FindAltKeyTarget $path $key] @@ -620,7 +625,7 @@ proc ::tk::AltKeyInDialog {path key} { } # ::tk::mcmaxamp -- -# Replacement for mcmax, used for texts with "magic ampersand" in it. +# Replacement for mcmax, used for texts with "magic ampersand" in it. # proc ::tk::mcmaxamp {args} { -- cgit v0.12