Many forms require the selection of pre-defined options and common methods of linking that to your data is by a primary id. So, to ease the burden of my own app, I made this snit widget. Bear in mind, I'm a novice and this is my first venture into snit and into making my own widget. Please, please, please comment or update the code if you find problems.
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
}Here is a sample of one way of using it:
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 .You can easily take the above app and drive it from PostgreSQL for example:
set res [pg_exec $dbh "SELECT id,name FROM types"] set greetings [pg_result $res -list] pg_result $res -clear