[Kevin 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: [http://yellowfieldtechnologies.files.wordpress.com/2011/11/toolbarpopover.png?w=600&h=489] And here's my Tk implementation: [http://www.codebykevin.com/popover.png] 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 {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 .} ====== --- [TR] This is a cool thing. But we can do even better. We can use the right MacWindowStyle (as exemplified in [Perfect Aqua Look] and build a canvas with a transparent background and the perfect shape! Like this: [http://tcl.typoscriptics.de/misc/popover.png] I now wrapped the popover code into a namespaced proc so it can be used easier and changed the placement code a bit (and got it wrong, the top of the triangle will not appear directly at the cursor, this is left as an exercise for the reader). We could embed even more of the code of the main program into the popover code in order to make it even easier to use. Ideally, the user would only need to provide the inner widgets of the popover and the proc would do the rest including proper window size and placement. This approach has also the advantage that the code automatically (or via a user option) could place the triangle at any place, more the the left or right of the upper edge or even on another side of the canvas. Anyway, here's my code, tested on Mac with Tcl 8.6: ====== namespace eval pop { variable Popover } proc pop::PopOver {cmd pop args} { # # a popover window that follows its parent # # cmd - a command for the PopOver. Can be: # create = creates a popover window from a new toplevel # show = shows the creates popover # pop - a toplevel window that has been or must be created with [pop::PopOver create ]) # args - additional args, see below # variable Popover switch $cmd { create { # # takes a new toplevel window that will be the popover later # # args= # parent - the parent window, which the popover should follow # lassign $args parent set Popover($pop,parent) $parent catch {destroy $pop} toplevel $pop -width 200 -height 400 wm overrideredirect $pop 1 wm transient $pop $parent bind $pop [list focus -force $pop] if {[winfo toplevel $parent] eq $parent} { wm protocol $parent WM_DELETE_WINDOW "destroy $pop ; destroy $parent" } wm withdraw $pop return $pop } fadeIn { # # fade the popover into view # # args= -none- # set prev_degree [wm attributes $pop -alpha] set new_degree [expr $prev_degree + 0.05] set current_degree [wm attributes $pop -alpha $new_degree] if {$new_degree < 1.0 && $new_degree != $prev_degree} { after 10 [list pop::PopOver fadeIn $pop] } else { return } } fadeOut { # # fade the popover out of view # # args= -none- # set prev_degree [wm attributes $pop -alpha] set new_degree [expr $prev_degree - 0.05] set current_degree [wm attributes $pop -alpha $new_degree] if {$new_degree > 0.0 && $new_degree != $prev_degree} { after 10 [list pop::PopOver fadeOut $pop -animate 1] } else { wm withdraw $pop } } hide { # # hide the popover from view # # args= # -animate = boolean flag, whether to fade the popover out # array set options {-animate 0} array set options $args if {$options(-animate)} {pop::PopOver fadeOut $pop} wm withdraw $pop } show { # # shows a previously created popover # # args= # -x = horizontal coordinate of where to place the popover # -y = vertical coordinate of where to place the popover # -width = width of the popover # -height = height of the popover # -animate = boolean flag, whether to fade the popover in # array set options [list -x [winfo pointerx $Popover($pop,parent)] -y [winfo pointery $Popover($pop,parent)] -width 200 -height 200 -animate 0] array set options $args set placex [expr $options(-x)-$options(-width)/2] set placey [expr $options(-y)+5] if {$options(-animate)} { wm attribute $pop -transparent 1 wm attributes $pop -alpha 0.0 } else { wm attribute $pop -transparent 0 wm attributes $pop -alpha 1.0 } wm deiconify $pop wm geometry $pop $options(-width)x$options(-height)+$placex+$placey raise $pop if {$options(-animate)} {pop::PopOver fadeIn $pop} } default {return -code error "pop::PopOver: no such cmd '$cmd'"} } } if 1 { # 1. main window: button .b -text "Show Popover" bind .b <1> {pop::PopOver show .pop -x %X -y %Y -animate 1} pack .b # 2. make popover: pop::PopOver create .pop . ## 3. modify popover to be the correct style: ::tk::unsupported::MacWindowStyle style .pop document {noTitleBar} wm attribute .pop -transparent 1 # 4. build the inner of the popover to match a Mac style NSPopover: grid [canvas .pop.t -width 200 -height 200 -highlightthickness 0] .pop.t configure -background systemTransparent .pop.t create polygon 70 15 80 0 90 15 -fill systemSheetBackground -outline systemSheetBackground .pop.t create polygon 12 22 12 160 150 160 150 22 12 22 \ -fill systemSheetBackground -outline systemSheetBackground -width 12 -joinstyle round # place some interactive elements on top of the canvas: #place [ttk::button .pop.b -text Exit! -command exit] -relx 0.25 -rely 0.3 #place [ttk::button .pop.c -text Hide! -command {pop::PopOver hide .pop -animate 1}] -relx 0.25 -rely 0.5 # or do it by creating windows in the canvas: .pop.t create window 75 50 -window [ttk::button .pop.b -text Exit! -command exit] .pop.t create window 75 75 -window [ttk::button .pop.c -text Hide! -command {pop::PopOver hide .pop -animate 1}] } ====== <> GUI