Combo -A aimple Combobox widget with entry history.

WJG (20/Mar/06) With so many comboboxes floating around you'd think that the lads in the core development team would have dropped one into the the standard Tk widget pack. Well, until today combobox widgets were ten a penny, but now, with my offering banging silently at the door the tally's 11!
 #---------------
 # combo.tcl
 #---------------
 #
 # by William J Giddings, 2006.
 #
 # Description:
 # -----------
 # Display a scrolled list box, pick, then perform some follow up action.
 # If the user types in a new value into the entry box and presses Enter, the
 # value will be added to the top of the list. Duplicate values are ignored.
 #
 # Usage:
 # -----
 # See demo code below
 #
 #---------------
 
 package require autoscroll ;# http://wiki.tcl.tk/11268

 namespace eval combo {}

 #---------------
 # create the widget
 #---------------
 proc combo {w args} {
  # Step 1) parge arguments  
  # initialise args lists
  set frameargs {}
  set entryargs {}
  set buttonargs {}
  set droplistargs {}
  
  # divide the args up between the widget components
  foreach {arg val} $args {
    switch -- $arg {
      -relief {
          append frameargs "$arg $val "
      }
      -borderwidth {
          append frameargs "$arg $val "
          append buttonargs "$arg $val"
          append droplistargs "$arg $val"
        }
      -image {
           append buttonargs "$arg $val "
        }
      default {
        append entryargs "$arg $val "
        }
    }
  }
  # default droplist button
  image create bitmap ::combo::bimage -data {
                #define down_arrow_width 12
                #define down_arrow_height 12
                static char down_arrow_bits[] = {
                    0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
                    0xfc,0xf1,0xf8,0xf0,0x70,0xf0,0x20,0xf0,
                    0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00;
                }
        }
        # Step 2) create the entry and button
  eval frame $w $frameargs
  eval entry $w.entry $entryargs -borderwidth 0
  eval button $w.but -image ::combo::bimage $buttonargs
  pack $w.entry -side left 
  pack $w.but -side right
  
  # bindings
  bind ${w}.entry <Key-Return> {
    combo::history %W [%W get]
    # perform our command
    eval [%W cget -vcmd ] [%W get]
  }
  
  bind $w.but <Button-1> {combo::droplist %W}
  
  # Step 3)create the associated droplist
  toplevel ${w}Drop
  wm withdraw ${w}Drop
  wm overrideredirect ${w}Drop 1
  
  eval listbox ${w}Drop.lb $droplistargs -borderwidth 1 
  pack  ${w}Drop.lb -side left -fill both -expand 1
  
  eval scrollbar ${w}Drop.scrl \
    -orient v \
    -borderwidth 1 \
    -elementborderwidth 1 \
    -highlightthickness 1 
    
  pack ${w}Drop.scrl -side left -fill y

  ${w}Drop.scrl configure -command "${w}Drop.lb yview"
  ${w}Drop.lb configure -yscrollcommand "${w}Drop.scrl set"
  
  ::autoscroll::autoscroll ${w}Drop.scrl
  
  # bindings  
  bind ${w}Drop <FocusOut> {
    focus [winfo parent %W]
    wm withdraw %W
  }
  bind ${w}Drop.lb <Button-1> {
    # set entry to match selection
    set [eval [string trimright [winfo parent %W] Drop].entry cget -textvariable] [%W get @%x,%y]
    wm withdraw [winfo toplevel %W]
    # perform our command
    eval [[string trimright [winfo parent %W] Drop].entry cget -vcmd ] [[string trimright [winfo parent %W] Drop].entry get]
  }
  
  # Step 4) completed, return path to widget
  return $w
 }

 #---------------
 # position and display the droplist
 #---------------
 proc combo::droplist {w} {
  set p [winfo parent $w]
  set x [winfo rootx $p]
  set x1 [winfo rootx $w]
  set y [expr [winfo rooty $p] + [winfo height $p] ]
  set width [winfo width $p]  ;#[expr $x1 -$x]
  set height 100
  wm geometry ${p}Drop ${width}x${height}+${x}+${y}
  wm deiconify ${p}Drop
  focus ${p}Drop
 }

 #---------------
 # add selection the history
 #---------------
 proc combo::history {w a} {
  set p [winfo parent $w]
  set b [${p}Drop.lb get 0 end ]
  #check to see if value already there..
  if { [lsearch -exact $b $a] == -1} { 
    ${p}Drop.lb insert 0 $a
  }
 }

 #---------------
 # add items to the list
 #---------------
 proc combo::list {w vals} {
  foreach i $vals {
    ${w}Drop.lb insert end $i
  }
 }

 #---------------
 # demo block
 #---------------
 proc show {args} {
  puts "Show> $args"
 }

 console show
 pack [combo .cb1 -textvariable cb(1) -relief sunken -borderwidth 1 -vcmd show] -side left 
 pack [combo .cb2 -textvariable cb(2) -relief sunken -borderwidth 1 -vcmd show] -side left 
 set cb(1) Fruits
 set cb(2) Vegitables
 combo::list .cb1 {Apple Banana Orange Cherry Apple Banana Orange Cherry Apple Banana Orange Cherry}
 combo::list .cb2 {Asparagus Broccoli Carrot}
Category GUI
Category Widget