#---------------
 # 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 photo ::combo::im_down -data {R0lGODlhCwALAJEAAP///9TQyAAAAAAAACwAAAAACwALAAACD4yPqavi/w6MaC56md68AAA7}

        # 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] + 2 ]
  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 Bannana Orange Cherry Apple Bannana Orange Cherry Apple Bannana Orange Cherry}
 combo::list .cb2 {Asparagus Broccoli Carrot}

    while executing

    (file "dev/combo.tcl" line 159)

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References