Version 1 of Cocoa-style popover on Mac.
Updated 2013-07-02 22:54:34 by kevinwalzerKevin Walzer: I've been interested in implementing a Cocoa-style NSPopover window in Tk (see https://developer.apple.com/library/mac/#documentation/AppKit/Reference/NSPopover_Class/Reference/Reference.html ). Using a few tricks from wm attributes, it is simpler to do in Tk than one might expect.
Here's what a native popover window looks like:
And here's my Tk implementation:
And finally, here's the code. It's not really feasible to make this a general package because we are drawing individual windows, not a standard structure with a string and image, but this should give you an idea of how to implement the window in your own apps.
proc create_popover {x y parent} {
catch {destroy .pop}
toplevel .pop -width 200 -height 400
wm overrideredirect .pop 1
wm attribute .pop -transparent 1
wm attributes .pop -alpha 0.0
wm transient .pop $parent
bind .pop <Any-Enter> {focus -force .pop}
frame .pop.f -bg systemTransparent
pack .pop.f -fill both -expand yes
ttk::label .pop.f.l -text \u25B2 -padding -3
pack .pop.f.l -side top -expand no
ttk::frame .pop.f.m -padding 5
pack .pop.f.m -side bottom -fill both -expand yes
ttk::button .pop.f.m.b -text "Close" -command {fade_out .pop}
pack .pop.f.m.b -side bottom -fill both -expand yes
text .pop.f.m.t
pack .pop.f.m.t -side bottom -fill both -expand yes
.pop.f.m.t insert end "Here is a Cocoa-style popover window in Tk.\n"
set placex [expr $x-100]
set placey [expr $y+5]
wm geometry .pop 200x400+$placex+$placey
raise .pop
fade_in .pop
}
proc fade_out {w} {
set prev_degree [wm attributes $w -alpha]
set new_degree [expr $prev_degree - 0.05]
set current_degree [wm attributes $w -alpha $new_degree]
if {$new_degree > 0.0 && $new_degree != $prev_degree} {
after 10 [list fade_out $w]
} else {
destroy $w
}
}
proc fade_in {w} {
set prev_degree [wm attributes $w -alpha]
set new_degree [expr $prev_degree + 0.05]
set current_degree [wm attributes $w -alpha $new_degree]
if {$new_degree < 1.0 && $new_degree != $prev_degree} {
after 10 [list fade_in $w]
} else {
return
}
}
button .b -text "Show Popover"
pack .b
bind .b <1> {create_popover %X %Y .}