proc ComboBox { ComboBox args} {

    # We shall always call our toplevel $ComboBox_tl 
    set w [format "%s_tl" $ComboBox]
    catch {destroy $w}
    toplevel $w 

    # Disable window manager control, borders, etc.
    wm overrideredirect $w 1

    listbox $w.list -yscroll "$w.yscroll set" -relief sunken -bd 1m
    scrollbar $w.yscroll -command "$w.list yview"
    pack $w.list -side left -in $w -fill both -expand yes
    pack $w.yscroll -side left -in $w -fill y

    frame $ComboBox
    
    # Hide the default frame procedure by renaming it
    rename $ComboBox $ComboBox.frame

    # Neat hack to pass $ComboBox right now and $args at run-time
    # From Zircon :-)
    proc $ComboBox {args} "eval ComboBox_call $ComboBox \$args"

    entry $ComboBox.e -relief sunken

    label $ComboBox.l 
    label $ComboBox.arrow -bitmap @/usr/local/PIX/xbm/ComboBox.xbm -relief raised 
    bind $ComboBox.arrow <1> "ComboBox_popup $ComboBox $w"

    pack $ComboBox.l $ComboBox.e -padx 1m -side left
    pack $ComboBox.arrow -side left -ipady 0.4m

    bind $w.list <ButtonRelease-1> "ComboBox_popdown $ComboBox $w"

    wm withdraw $w

    if { [string length $args] } {
	eval ComboBox_configure $ComboBox $args
    }
}

# Proc to call the actual proc - we need to levels of indirection/evals
# in order to pass args at run time and $ComboBox at creation time.
# Thanks to Zircon for this neat hack
proc ComboBox_call {this op args} {

    set errno [catch {eval ComboBox_$op $this $args} errmsg]
    if { $errno } {
	tk_dialog ${this}_d Error "ERROR: Unknown ComboBox \
		widget function $op !" error 0 OK
	return -1
    } else {
	return "$errmsg"
    }
	
}

# Proc to return the value of the ComboBox's entry field
proc ComboBox_get { ComboBox args} {
    return [$ComboBox.e get]
}

# Proc to set the value of the ComboBox's entry field
# The programmer could use this function to work-around the strict mode
# but then, the programmer is always right :-)
proc ComboBox_set { ComboBox args} {

    if { ![string compare [$ComboBox.e cget -state] "disabled"] } {
	$ComboBox.e configure -state normal
	$ComboBox.e delete 0 end
	$ComboBox.e insert end [lindex $args 0]
	$ComboBox.e configure -state disabled
    } else {
	$ComboBox.e delete 0 end
	$ComboBox.e insert end [lindex $args 0]
    }
}

# Proc to clear the value of the ComboBox's entry field
proc ComboBox_clear { ComboBox args} {
    if { ![string compare [$ComboBox.e cget -state] "disabled"] } {
	$ComboBox.e configure -state normal
	$ComboBox.e delete 0 end
	$ComboBox.e configure -state disabled
    } else {
	$ComboBox.e delete 0 end
    }
}

# Proc to remove elements from the listbox
proc ComboBox_del { ComboBox args } {
    # The toplevel is
    set w [format "%s_tl" $ComboBox]

    $w.list delete [lindex $args 0] [lindex $args 1]
}

# Proc to add elements to the listbox
proc ComboBox_add { ComboBox args } {

    # The toplevel is
    set w [format "%s_tl" $ComboBox]

    foreach value $args {
	$w.list insert end $value
    }

}

# Proc to emulate the cget command. 
proc ComboBox_cget { ComboBox args } {

    # The toplevel is
    set w [format "%s_tl" $ComboBox]

    # We shall ignore any arguments beyond the first one, rather than 
    # throwing up an error message.
    set option [lindex $args 0]

    if { [regexp {^-e} $option] } {
	return [$ComboBox.e cget [format "-%s" [string range $option 2 end]]]
    } 
    
    if { [regexp {^-lbl} $option] } {
	return [$ComboBox.l cget [format "-%s" [string range $option 4 end]]]
    }
    if { [regexp {^-list} $option] } {
	return [$w.list cget [format "-%s" [string range $option 5 end]]]
    }
    if { [regexp {^-strict} $option] } {
	return [$ComboBox.e cget -state]
    }
    # The -cursor switch sets the cursor for all component widgets
    if { [regexp {^-cursor} $option] } {
	return [$ComboBox.e cget -state]
    }

    # If we have got this far, $option is unknown
    tk_dialog ${ComboBox}_d Error "ERROR: Unknown ComboBox cget option $option !" error 0 OK
    return "ERROR"
}

# Proc to configure the widget
proc ComboBox_configure { ComboBox args} {

    # The toplevel is
    set w [format "%s_tl" $ComboBox]

    set i 0
    foreach option $args {
	if { [regexp {^-} $option] } {
	    set tag $option
	} else {
	    switch -- $tag {
		"-efont" { $ComboBox.e configure -font $option }
		"-efg" { $ComboBox.e configure -fg $option }
		"-ebg" { $ComboBox.e configure -bg $option }
		"-ebd" { $ComboBox.e configure -bd $option }
		"-ehighlightthickness" { $ComboBox.e configure -highlightthickness $option }
		"-ewidth" { $ComboBox.e configure -width $option }
		"-erelief" { $ComboBox.e configure -relief $option }
		"-lblfont" { $ComboBox.l configure -font $option }
		"-lblfg" { $ComboBox.l configure -fg $option }
		"-lblbg" { $ComboBox.l configure -bg $option }
		"-lblbd" { $ComboBox.l configure -bd $option }
		"-lbltext" { $ComboBox.l configure -text $option }
		"-lblrelief" { $ComboBox.l configure -relief $option }
		"-listfont" { $w.list configure -font $option }
		"-listheight" { $w.list configure -height $option }
		"-listwidth" { $w.list configure -width $option }
		"-listfg" { $w.list configure -fg $option }
		"-listbg" { $w.list configure -bg $option }
		"-listbd" { $w.list configure -bd $option }
		"-listrelief" { $w.list configure -relief $option }
		"-cursor" { $ComboBox.e configure -cursor $option; $ComboBox.l configure -cursor $option; $ComboBox.arrow configure -cursor $option }
		"-strict" { if {$option == 1} { $ComboBox.e configure -state disabled } else { $ComboBox.e configure -state normal} }
		default { tk_dialog ${ComboBox}_d Error "ERROR: Bad combobox configure option $tag" \
			error 0 OK }
	    }
	}
	incr i
    }

    if { $i%2 } {
	tk_dialog ${ComboBox}_d Error "ERROR: You called ComboBox_configure with an odd number of args !" \
		error 0 OK
	return -1
    }

    return 0
}

proc ComboBox_popdown { {frame .f} {win .combobox} } {

    if { ![string compare [$frame.e cget -state] "disabled"] } {
	$frame.e configure -state normal
	$frame.e delete 0 end
	$frame.e insert end [$win.list get [$win.list curselection]]
	$frame.e configure -state disabled
    } else {
	$frame.e delete 0 end
	$frame.e insert end [$win.list get [$win.list curselection]]
    }
    wm withdraw $win
    grab release .
}

# Calculate the position of the listbox and pop it up. Code hacked from Tix
# Thanks, Ioi !
proc ComboBox_popup { {frame .f} {win .combobox} } {

    if { ![string compare [wm state $win] "normal"] } {
	wm withdraw $win
	grab release .
	return 0
    }

    # calculate the size
    set  y [winfo rooty $frame.e]
    incr y [winfo height $frame.e]
    incr y 3

    set bd [$win cget -bd]
    incr bd [$win cget -highlightthickness]
    set height [expr [winfo reqheight $win.list] + 2*$bd]

    set x1 [winfo rootx $frame.e]
    set x2  [winfo rootx $frame.arrow]
    incr x2 [winfo width $frame.arrow]
    set width  [expr "$x2 - $x1"]
    
    set reqwidth [winfo reqwidth $win]
    if {$reqwidth < $width} {
	set reqwidth $width
    } else {
	if {$reqwidth > [expr $width *3]} {
	    set reqwidth [expr $width *3]
	}
	if {$reqwidth > [winfo vrootwidth .]} {
	    set reqwidth [winfo vrootwidth .]
	}
    }
    set width $reqwidth

    # If the listbox is too far right, pull it back to the left
    #
    set scrwidth [winfo vrootwidth .]
    if {$x2 > $scrwidth} {
	set x1 [expr $scrwidth - $width]
    }

    # If the listbox is too far left, pull it back to the right
    #
    if {$x1 < 0} {
	set x1 0
    }

    # If the listbox is below bottom of screen, put it upwards
    #
    set scrheight [winfo vrootheight .]
    set bottom [expr $y+$height]
    if {$bottom > $scrheight} {
	set y [expr $y-$height-[winfo height $frame.e]-5]
    }
 
    # OK , popup the shell
    #

    wm geometry $win $reqwidth\x$height+$x1+$y
    wm deiconify $win
    raise $win
    focus $frame.e

    # Grab the server so that user cannot move the windows around
    #
    # $data(rootCmd) config -cursor arrow
    catch {
	# We catch here because grab may fail under a lot of circumstances
	# Just don't want to break the code ...
	grab -global .
    }

}
