Import Tk 8.6.10
This commit is contained in:
Steve Dower
@@ -61,43 +61,112 @@ if {[tk windowingsystem] eq "x11"} {
|
||||
}
|
||||
|
||||
# PostPosition --
|
||||
# Returns the x and y coordinates where the menu
|
||||
# should be posted, based on the menubutton and menu size
|
||||
# and -direction option.
|
||||
# Returns x and y coordinates and a menu item index.
|
||||
# If the index is not an empty string the menu should
|
||||
# be posted so that the upper left corner of the indexed
|
||||
# menu item is located at the point (x, y). Otherwise
|
||||
# the top left corner of the menu itself should be located
|
||||
# at that point.
|
||||
#
|
||||
# TODO: adjust menu width to be at least as wide as the button
|
||||
# for -direction above, below.
|
||||
#
|
||||
proc ttk::menubutton::PostPosition {mb menu} {
|
||||
set x [winfo rootx $mb]
|
||||
set y [winfo rooty $mb]
|
||||
set dir [$mb cget -direction]
|
||||
|
||||
set bw [winfo width $mb]
|
||||
set bh [winfo height $mb]
|
||||
set mw [winfo reqwidth $menu]
|
||||
set mh [winfo reqheight $menu]
|
||||
set sw [expr {[winfo screenwidth $menu] - $bw - $mw}]
|
||||
set sh [expr {[winfo screenheight $menu] - $bh - $mh}]
|
||||
|
||||
switch -- $dir {
|
||||
above { if {$y >= $mh} { incr y -$mh } { incr y $bh } }
|
||||
below { if {$y <= $sh} { incr y $bh } { incr y -$mh } }
|
||||
left { if {$x >= $mw} { incr x -$mw } { incr x $bw } }
|
||||
right { if {$x <= $sw} { incr x $bw } { incr x -$mw } }
|
||||
flush {
|
||||
# post menu atop menubutton.
|
||||
# If there's a menu entry whose label matches the
|
||||
# menubutton -text, assume this is an optionmenu
|
||||
# and place that entry over the menubutton.
|
||||
set index [FindMenuEntry $menu [$mb cget -text]]
|
||||
if {$index ne ""} {
|
||||
incr y -[$menu yposition $index]
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
proc ::ttk::menubutton::PostPosition {mb menu} {
|
||||
set menuPad 5
|
||||
set buttonPad 1
|
||||
set bevelPad 4
|
||||
set mh [winfo reqheight $menu]
|
||||
set bh [expr {[winfo height $mb]} + $buttonPad]
|
||||
set bbh [expr {[winfo height $mb]} + $bevelPad]
|
||||
set mw [winfo reqwidth $menu]
|
||||
set bw [winfo width $mb]
|
||||
set dF [expr {[winfo width $mb] - [winfo reqwidth $menu] - $menuPad}]
|
||||
set entry ""
|
||||
set entry [::tk::MenuFindName $menu [$mb cget -text]]
|
||||
if {$entry eq ""} {
|
||||
set entry 0
|
||||
}
|
||||
set x [winfo rootx $mb]
|
||||
set y [winfo rooty $mb]
|
||||
switch [$mb cget -direction] {
|
||||
above {
|
||||
set entry ""
|
||||
incr y [expr {-$mh + 2 * $menuPad}]
|
||||
}
|
||||
below {
|
||||
set entry ""
|
||||
incr y $bh
|
||||
}
|
||||
left {
|
||||
incr y $menuPad
|
||||
incr x -$mw
|
||||
}
|
||||
right {
|
||||
incr y $menuPad
|
||||
incr x $bw
|
||||
}
|
||||
default {
|
||||
incr y $bbh
|
||||
}
|
||||
}
|
||||
return [list $x $y $entry]
|
||||
}
|
||||
} else {
|
||||
proc ::ttk::menubutton::PostPosition {mb menu} {
|
||||
set mh [expr {[winfo reqheight $menu]}]
|
||||
set bh [expr {[winfo height $mb]}]
|
||||
set mw [expr {[winfo reqwidth $menu]}]
|
||||
set bw [expr {[winfo width $mb]}]
|
||||
set dF [expr {[winfo width $mb] - [winfo reqwidth $menu]}]
|
||||
if {[tk windowingsystem] eq "win32"} {
|
||||
incr mh 6
|
||||
incr mw 16
|
||||
}
|
||||
set entry {}
|
||||
set entry [::tk::MenuFindName $menu [$mb cget -text]]
|
||||
if {$entry eq {}} {
|
||||
set entry 0
|
||||
}
|
||||
set x [winfo rootx $mb]
|
||||
set y [winfo rooty $mb]
|
||||
switch [$mb cget -direction] {
|
||||
above {
|
||||
set entry {}
|
||||
incr y -$mh
|
||||
# if we go offscreen to the top, show as 'below'
|
||||
if {$y < [winfo vrooty $mb]} {
|
||||
set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\
|
||||
+ [winfo reqheight $mb]}]
|
||||
}
|
||||
}
|
||||
below {
|
||||
set entry {}
|
||||
incr y $bh
|
||||
# if we go offscreen to the bottom, show as 'above'
|
||||
if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} {
|
||||
set y [expr {[winfo vrooty $mb] + [winfo vrootheight $mb] \
|
||||
+ [winfo rooty $mb] - $mh}]
|
||||
}
|
||||
}
|
||||
left {
|
||||
incr x -$mw
|
||||
}
|
||||
right {
|
||||
incr x $bw
|
||||
}
|
||||
default {
|
||||
if {[$mb cget -style] eq ""} {
|
||||
incr x [expr {([winfo width $mb] - \
|
||||
[winfo reqwidth $menu])/ 2}]
|
||||
} else {
|
||||
incr y $bh
|
||||
}
|
||||
}
|
||||
}
|
||||
return [list $x $y $entry]
|
||||
}
|
||||
|
||||
return [list $x $y]
|
||||
}
|
||||
|
||||
# Popdown --
|
||||
@@ -107,8 +176,8 @@ proc ttk::menubutton::Popdown {mb} {
|
||||
if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
|
||||
return
|
||||
}
|
||||
foreach {x y} [PostPosition $mb $menu] { break }
|
||||
tk_popup $menu $x $y
|
||||
foreach {x y entry} [PostPosition $mb $menu] { break }
|
||||
tk_popup $menu $x $y $entry
|
||||
}
|
||||
|
||||
# Pulldown (X11 only) --
|
||||
@@ -121,13 +190,17 @@ proc ttk::menubutton::Pulldown {mb} {
|
||||
if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
|
||||
return
|
||||
}
|
||||
foreach {x y} [PostPosition $mb $menu] { break }
|
||||
set State(pulldown) 1
|
||||
set State(oldcursor) [$mb cget -cursor]
|
||||
|
||||
$mb state pressed
|
||||
$mb configure -cursor [$menu cget -cursor]
|
||||
$menu post $x $y
|
||||
foreach {x y entry} [PostPosition $mb $menu] { break }
|
||||
if {$entry ne {}} {
|
||||
$menu post $x $y $entry
|
||||
} else {
|
||||
$menu post $x $y
|
||||
}
|
||||
tk_menuSetFocus $menu
|
||||
}
|
||||
|
||||
@@ -143,6 +216,7 @@ proc ttk::menubutton::TransferGrab {mb} {
|
||||
set State(pulldown) 0
|
||||
|
||||
set menu [$mb cget -menu]
|
||||
foreach {x y entry} [PostPosition $mb $menu] { break }
|
||||
tk_popup $menu [winfo rootx $menu] [winfo rooty $menu]
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user