Posted to tcl by jeremy_c at Fri Sep 14 15:55:35 GMT 2007view pretty

package require Tk
package require tile

package require snit

snit::widget idlabelmenubutton {
	hulltype ttk::frame
	
	delegate option -width to mb
	delegate option -direction to mb

	option -textvariable  {}
	option -listvariable  {}
	option -idvariable    {}
	
	variable ids -array {}
	variable item_id    -1

	constructor {args} {
		install mb using ttk::menubutton $win.mb
		$self configurelist $args
		$win.mb configure -textvariable $options(-textvariable)
		pack $win.mb -padx 0 -pady 0 -expand 1 -fill x
		
		install mopts using menu $win.menu
		$win.mb configure -menu $win.menu

		upvar #0 $options(-idvariable) idvar
		upvar #0 $options(-listvariable) listvar
		trace add variable idvar   write [list $self id_updated]
		trace add variable listvar write [list $self list_updated]
		
		$self list_updated
		$self id_updated
	}
	
	method add {id label} {
		$win.menu add command -label $label -command [list $self update $id $label]
		set ids($id) $label
	}
	
	method clear {} {
		catch {$win.menu delete 0 end}
	}
	
	method item_id {} {
		return $item_id
	}
	
	method update {new_id new_text} {
		$win.mb configure -text $new_text
		set item_id $new_id
		
		upvar #0 $options(-idvariable) idvar
		upvar #0 $options(-textvariable) textvar
		catch {set idvar $new_id}
		catch {set textvar $new_text}
	}
	
	method id_updated {{var {}} {args {}}} {
		upvar #0 $options(-idvariable) idvar
		upvar #0 $options(-textvariable) textvar
		if {[catch {
				if {$idvar == {}} {
					return
				}}]} {
			return
		}
		
		if {[catch {set textvar $ids($idvar)}]} {
			return -code 1 "$idvar not found in idlabelmenubutton"
		}
	}
	
	method list_updated {{var {}} {args {}}} {
		upvar #0 $options(-listvariable) listvar
		if {$listvar == {}} {
			return
		}
		$win.mb configure -text ""
		$self clear
		foreach {id label} $listvar {
			$self add $id $label
		}
		$self id_updated
	}
	
	delegate method * to mb
}

set greetingid 1
set greeting ""
set greetings {1 Hello 3 "What's Up" 2 Goodbye}

ttk::frame .f
pack .f -expand 1 -fill both

ttk::label .f.greeting_l   -text "Greeting:"
idlabelmenubutton .f.greeting -listvariable greetings -width 10
ttk::button .f.greet -text "Greet" -command {
	tk_messageBox -message "$greeting, World!"
}

grid .f.greeting_l .f.greeting -padx 3 -pady 3
grid .f.greet -column 1 -padx 3 -pady 3 -sticky w

wm title . "Greeter"
raise .