Gnocl Cookbook‎ > ‎

Positioning a Popupmenu Beneath a Triggering Widget





#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

if { [catch { package present Gnocl } ] } { package require Gnocl }


## display menuButton menu, adjust positionsing for right-edge/bottom of screen
#/param w button widget-id
#/param d menu widget-id
#/returns none
proc gnocl::mbPopup { w d } {
       
        lassign [gnocl::winfo geometry $w] x y w h               
        $d popup $x [expr $y+$h]
               
        lassign [gnocl::winfo geometry $d] mx my mw mh
        lassign [gnocl::screen geometry] sw sh
                               
        if { [expr ($y+$h+$mh) > $sh ] } {
                set y [expr $y - $mh]
        } else {
                set y [expr $y + $h]
        }

        if { [expr ($x+$mw) > $sw ] } { set x [expr $sw - $mw] }
       
        $d popup $x $y

}

## implement widget commands
#/param args standard series of options for gnocl::button, plus -menu
#/returns menu button widget-id
proc gnocl::menuButton { args } {
       
        # extract -menu option and discard -onClicked
        array set tmp $args
        set menu $tmp(-menu)
        array unset tmp -menu
        array unset tmp -onClicked
               
        set res [gnocl::button {*}[array get tmp]]
        $res configure -onClicked "gnocl::mbPopup $res $menu"
       
        return $res
}


## Demonstrate menuButton
proc main { args } {

        # create menu
        set ::app(languages) [list \
            {"Sanskrit (D)" sk} \
            {"Sanskrit (I)" sk} \
            {"Pali (I)" pa} \
            {"Pali (D)" pa} \
            {Chinese zh} \
            {"Tibetan (U)" bo} \
            {"Tibetan (W)" bo} ]

        set menu [gnocl::menu -title "menu" -tearoff 0]
        foreach item $::app(languages) {
                $menu add [gnocl::menuCheckItem \
                    -text [lindex $item 0] \
                    -onToggled {puts "load item 1"}]
        }       

        # create menuButton and attach to a window
        gnocl::window -title MB \
            -width 100 -height 100 \
            -child [gnocl::menuButton \
                        -menu $menu \
                        -icon %#Preferences \
                        -text "Click Me"]

}



main
ċ
popupMenuPosition.tcl
(2k)
William Giddings,
27 Mar 2019, 01:29
Comments