Dropdown windows

Sometimes people design widgets like combobox, and they usually reinvent the procedure that places an overrideredirect'ed toplevel with a dropdown list (or tree or some other widget) near its parent widget. Such a procedure, initially clean and simple, grows as the widget gets mature and bug reports arrive. What if there's no room below the widget? Well, let's post the "dropdown" above. What if the combobox is crossing the screen boundary itself? The dropdown list's position is corrected again. What if the combobox must be wide and the listbox is narrow (or vice versa) - some people want the listbox to be the same width, others don't.

Below is a code snippet that tries to address every issue of putting a dropdown near a widget. I've tried to generalize its front-end procedure, wdropdown, as much as possible, so it doesn't even require any widget to exist: rectangle or point coordinates may be given instead of a parent widget name, and the dropdown window name is not used when -width and -height are given as integers and -return is present.

wdropdown will automatically invert the direction if it's better for the child window (i.e. if it has to shrink when posted below -> post it above, the same for left/right). For the exact definition of "better", look at the comments for DropdownBestRectangle.

BWidget::place is a similar thing, but wdropdown is more flexible.

PT 25-Aug-2005: This fails to handle multiple monitors on Windows - the transient window ends up displayed on the wrong monitor. The transient window also appears behind the main window often. [tk::PlaceWindow] and [BWidget::place] do the right thing on Windows multi-monitor but loose the ability to keep the transient window within the desktop as Tk is unable to determine the true geometry of the desktop.

Fixed a trivial syntax error in the code.

A/AK 25-Aug-2005 Thanks PT. Not modifying Z-order and other properties of the window is intentional. wdropdown is for setting window's geometry and it leaves to the calling application all other settings, as they may depend on what the application needs.

namespace eval ::monster::wmu {}

# wdropdown  whichWindow  parentWindow  ?options?
# Places window "near" another window, with the meaning of "near"
# depending on options:
# -dimensions {requested|parent|current|<integer>}
# -width {requested|parent|current|<integer>}
# -height {requested|parent|current|<integer>}
#    these options determine the new size of the dropdown window.
#    -dimensions is generic, may be overridden by -width and -height 
#    requested = use winfo reqwidth/reqheight, 
#    current = use winfo width/height,
#    parent = equal to parent's width/height,
#    <integer> = size in pixels
# -direction gives a direction, similar to BWidget/utils.tcl
#    below / above / left / right
# -distance gives the amount of pixels that must be left between
#    the closest edges of the dropdown window and the parent (0=default,
#    that means that the dropdown will "touch" the parent).
#    Negative distance may be used to make the dropdown window overlap
#    the parent (1-2 pixels is often desirable for combobox)
# -fixed 
#    left|right for below/above, top|bottom for left/right direction
#    If the dropdown window is of another size than its parent,
#    this option determines WHICH edge of the child window will
#    be 'attached' to THE SIMILAR edge of the parent.
# -return xywh|ltrb|geometry
#    don't move/resize window, return the calculated geometry instead:
#       xywh - return [list x y width height]
#       ltrb - return [list left top right bottom]
#       geometry - return WxH+X+Y 
# If there's NO REAL PARENT WIDGET, only a point or rectangle,
# the parent argument may be a list of 2 or 4 values,
# {x y} for points and {left top right bottom} for rectangles.
proc ::monster::wmu::wdropdown {path parent args} {
    array set opts {-return {} -dimensions {requested} -direction below}
    array set opts $args
    set reversematrix 0
    lassign [
        switch -exact -- $opts(-direction) {
            below { list vertical 0 left }
            above { list vertical 1 left }
            left { list horizontal 1 top }
            right { list horizontal 0 top }
        } ] \
        opts(-orient) reversematrix deffixed
    if {![info exists opts(-fixed)]} { set opts(-fixed) $deffixed }
    set mtxlist [DropdownMatrices [array get opts]]
    if {$reversematrix} {
        set mtxlist [list [lindex $mtxlist 1] [lindex $mtxlist 0]]
    if {[winfo exists $parent]} {
        set L [winfo rootx $parent]
        set T [winfo rooty $parent]
        set R [expr {$L+[winfo width $parent]-1}]
        set B [expr {$T+[winfo height $parent]-1}]
    } else {
        if {[llength $parent] == 2} {
            lassign $parent L T 
            lassign $parent R B 
        } else {
            lassign $parent L T R B
    foreach dim {width height} {
        if {[info exists opts(-$dim)]} {
            set algo $opts(-$dim)
        } else {
            set algo $opts(-dimensions)
        if {[string is integer $algo]} {
            set value $algo
        } else {
            switch -exact -- $algo {
                requested {set value [winfo req$dim $path] }
                current {set value [winfo $dim $path] }
                parent {set value [winfo $dim $parent] }
                default {
                    return -code error \
                    "Bad dimension specifier $algo: \
                    should be requested, current, parent or INTEGER."
        set REQ($dim) $value
    set rect [DropdownBestRectangle $mtxlist $L $T $R $B \
            [winfo screenwidth $parent] \
            [winfo screenheight $parent] \
            $REQ(width) $REQ(height) ]
    lassign $rect cL cT cR cB
    set cW [expr {$cR-$cL+1}]
    set cH [expr {$cB-$cT+1}]
    switch -exact -- $opts(-return) {
        {}   {wm geometry $path ${cW}x${cH}+$cL+$cT}
        geometry {return ${cW}x${cH}+$cL+$cT}
        xywh     {return [list $cL $cT $cW $cH]}
        ltrb     {return [list $cL $cT $cR $cB]}
        default  {return -code error "Bad -return: must be geometry, xywh or ltrb"}

# Really deep magic workhorse procedure that calculates a best 
# position for a window that should be shown "near" another window
# It takes the list of placement matrices to select the best one of them
# to apply, L-T-R-B rectangle of the parent window, screen width
# and height and requested child width and height.
# Returns a L-T-R-B rectangle of the child window, adjusted so 
# the window will be totally visible.
# Placement matrix layout:
#   matrix ::= [list $xMatrix $yMatrix]
#   xMatrix ::= [list $qParentLeft $qParentRight $qChildW $offsetX]
#   yMatrix ::= [list $qParentTop $qParentBottom $qChildH $offsetY]
# Placement matrix application:
#   x(child) = left(parent)*qParentLeft + right(parent)*qParentRight +
#              + width(child)*qChildW + offsetX
#   y(child) = top(parent)*qParentTop + bottom(parent)*qParentBottom +
#              + height(child)*qChildH + offsetY
# Algorithm details:
# For each matrix and each coordinate, an "offence" value is calculated.
# The "offence" is > 0 when a calculated rectangle of a child window
# crosses the screen boundaries. Then the matrix with the minimal 
# overall (x+y) "offence" is selected, and the children's coordinates
# are adjusted to prevent crossing the screen.
# If all matrices produce the same offence (offence=0 is the common case),
# the first matrix is chosen.

proc ::monster::wmu::DropdownBestRectangle {
    matrices L T R B screenw screenh childw childh
}   {
    set priority 0
    foreach matrix $matrices {
        set dims [list]
        set coords [list]
        set overall_offence 0
        foreach \
            row $matrix \
            mults [list [list $L $R $childw 1] [list $T $B $childh 1]] \
            limit [list $screenw $screenh] \
            size [list $childw $childh] \
            set coord 0
            foreach q $row d $mults {incr coord [expr {$q*$d}]}
            set offence_toofar [expr {$coord+$size-$limit}]
            if {$offence_toofar<0} {set offence_toofar $priority}
            set offence_negative [expr {$coord<0? -$coord:$priority}]
            set offence [expr {$offence_toofar+$offence_negative}]
            incr overall_offence $offence
            if {$offence > 1} {
                lassign $row d0 d1 d2
                set shrink [expr \
                    {!(($d0==1 &&$d1==0 &&$d2==0)||
                if {$coord<0} {
                    if {$shrink} {
                        incr size $coord
                    set coord 0
                if {$offence_toofar>1} {
                    if {$shrink} {
                        set size [expr {$size-$offence_toofar}]
                    } else {
                        set coord [expr {$coord-$offence_toofar}]
            lappend coords $coord
            lappend dims $size
        lappend xycoords $coords
        lappend xydims $dims
        lappend xyoffences $overall_offence
        if {!$overall_offence} {break} 
        incr priority
    set index [expr {[lindex $xyoffences end]<[lindex $xyoffences 0]}]
    lassign [lindex $xycoords $index] x y
    lassign [lindex $xydims $index] w h
    return [list $x $y [expr {$x+$w-1}] [expr {$y+$h-1}]]

# Turns human-readable options for dropdown placement 
# into matrix list for DropdownBestRectangle.
# -orient vertical: for combobox dropdown list.
# -orient horizontal: for submenu of a normal/tearoff menu
# -fixed {left|right} for vertical, {top|bottom} for horizontal: 
#   which edge of the child window will go at the same coordinate
#   as the same edge of its parents. I've seen comboboxes where
#   left,right or both edges were 'fixed'.
# DropdownBestRectangle look at the -orient (well, really at the matrix)
# when adjusting a child window: the window will be SHRUNK if the axis
# that must be adjusted is PARALLEL to -orient, otherwise it will be MOVED.
# Thus e.g. the combobox may shrink vertically, but not horizontally.

proc ::monster::wmu::DropdownMatrices {{optList {}}} {
    array set opts {-fixed left -orient vertical -distance 0}
    array set opts $optList
    switch -exact -- $opts(-fixed).$opts(-orient) {
        left.vertical {
            set m {{{1 0 0 0} {0 1 0 0}} {{1 0 0 0} {1 0 -1 0}}}
        right.vertical {
            set m {{{0 1 -1 0} {0 1 0 0}} {{0 1 -1 0} {1 0 -1 0}}}
        top.horizontal {
            set m {{{0 1 0 0} {1 0 0 0}} {{1 0 -1 0} {1 0 0 0}}}
        bottom.horizontal {
            set m {{{0 1 0 0} {0 1 -1 0}} {{1 0 -1 0} {0 1 -1 0}}}
    if {$opts(-distance)} {
        set is_vertical [expr {$opts(-orient) eq "vertical"? 1 : 0 }]
        lset m 0   $is_vertical end $opts(-distance)
        lset m end $is_vertical end [expr {-$opts(-distance)}]
    return $m

# Forward-compatible lassign
if {[info commands lassign]==""} {
    proc lassign {list args} {
        foreach item $list var $args {
            if {$var eq ""} {break}
            upvar 1 $var v
            set v $item
        lrange $list [llength $args] end