Updated 2012-07-01 05:17:38 by RLE

Explanation edit

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.

snidget

Code edit

 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
 }

Example of using it edit

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