[Richard Suchenwirth] 2002-08-17 - The [BWidgets] package is a set of
powerful megawidgets written in pure Tcl. Examination of the source code
shows that it is easy to add functionality which can be called in Tk's
object-oriented way: if you provide a proc ''Class::command'', where
''class'' is one of BWidget's widget classes, calls  to a widget of that
class with that command will be dispatched to your "method", e.g.
 proc Foo::grill {w ...} {...}
 Foo .bar
 .bar grill args ;# calls Foo::grill .bar args
I employ this simple protocol to extend ComboBoxes for two typical use
cases (to appear in [starDOM]):
   * a "history", where previous inputs are recorded in the list of values used as a stack - the last input is on top (just below a blank field for new random input);
   * a "chooser" where you can only select one of the pre-defined alternatives (basically just a reconfiguration).
}
 
 package require BWidget
 namespace eval ComboBox {#needed to extend BWidget functionality}

 proc ComboBox::enable {w what args} {
    switch -- $what {
        history {
            $w configure -values {{}} ;# always keep a blank on top
            foreach evt {<Return> <FocusOut>} {
                $w bind $evt {+ ComboBox::_add %W [%W cget -text]}
            }
        }
        chooser {
            set values [$w cget -values]
            set width 0
            foreach i $values {
                set sl [string length $i]
                if {$sl > $width} {set width $sl}
            }
            $w setvalue first
            $w configure -width [expr {$width+1}]
            $w configure -editable 0 -relief flat -entrybg grey ;# (1)
        }
    }
    if {$args != ""} {eval [list $w configure] $args}
 }
 # This "internal" function is underscore-prefixed:
 proc ComboBox::_add {w item} {
    set w [winfo parent $w] ;# binding comes from entry
    set values [$w cget -values]
    if {[lsearch -exact $values $item] < 0} {
        $w configure -values [linsert $values 1 $item]
    }
 }
 #------------------------------------------- Test and demo code:
 if {[file tail [info script]]==[file tail $argv0]} {
    ComboBox .c -label "Search " -textvariable query
    .c bind <Return> {puts [list search -$mode $query]}
    .c enable history
     ComboBox .m -values {case nocase regexp XPath} -textvariable mode
     .m enable chooser
     pack .c .m -side left
     bind . <Escape> {exec wish $argv0 &; exit}
     bind . ? {console show}
 }

#(1) "grey" looks ok on Win 95, but not on Win2k. The better way would be to read the default background from another widget.