# SpecTcl, by S. A. Uhler and Ken Corey
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# combobox - create a combobox
# window - what to call the combobox
# listproc - a routine to call to populate the listbox
# cmdproc - a routine to call when enter is pressed in the entry widget, or
#          something is double clicked on.

proc combobox {window {listproc {}} {cmdproc {}} args} {
    global tcl_platform tkPriv
    set tkPriv(relief) raised
    set result [frame $window -relief sunken -bd 1 -highlightthickness 2]
    rename $window _$window
    if {$result != {}} {
	if {[info comm down_bm] == {}} {
	    set down_bm {
		#define dwnarrow.icn_width 15
		#define dwnarrow.icn_height 15
		static unsigned char dwnarrow.icn_bits[] = {
		    0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07,
		    0xe0, 0x07, 0xfc, 0x3f, 0xf8, 0x1f, 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03,
		    0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
	    }
	    image create bitmap down_bm -data [set down_bm]
	    unset down_bm
	}
	
	entry ${window}.e -bg \#f0f0f0 -highlightthickness 0 -bd 1
        label ${window}.b -relief raised -bd 1 -image down_bm -highlightthickness 0
	bind ${window}.b <1> "combobox_drop ${window} [list $listproc];%W config -relief sunken"
	bind ${window}.b <ButtonRelease-1> "%W config -relief raised"

	toplevel ${window}_f -relief raised -bd 1
	wm overrideredirect ${window}_f 1
	wm transient ${window}_f
	wm withdraw ${window}_f
#	frame ${window}_f -relief raised -bd 1
	listbox ${window}_f.lb -relief sunken -bd 1 -yscrollc "${window}_f.sb set"
	scrollbar ${window}_f.sb -bd 1 -command "${window}_f.lb yview"
	
	grid ${window}.e -row 0 -column 0 -sticky {nsew}
	grid ${window}.b -row 0 -column 1 -sticky {e}
	grid columnconfig ${window} 0 -weight 5
	pack ${window}_f.lb -side left -fill both
	pack ${window}_f.sb -side left -fill y

	# These are to make sure that these keys don't get out of comboboxes.
	# This is mostly because the menu editor automatically binds to 'all'.
	# The *right* thing would be for the menu editor to make it's own bindings
	# and have everyone interested add the bindtag.  Unfortunately, I don't do that 
	# right now.  *sigh*
	bind ${window}.e  <Insert> {
	    catch {tkEntryInsert %W [selection get -displayof %W]}
	    break
	}
	bind ${window}.e <Delete> {
	    if [%W selection present] {
		%W delete sel.first sel.last
	    } else {
		%W delete insert
	    }
	    break
	}
	bind ${window}_f.lb <Insert> {break}
	bind ${window}_f.lb <Delete> {break}

	set tagname [winfo name $window]_cbox
	foreach q "${window}_f ${window}_f.lb ${window}_f.sb" {
	    bindtags $q [concat ${tagname} [bindtags $q]]
	}

# These were supposed to make tabbing in the combobox easier, but they
# ended up causing extra focuses that confused things.
#	bind $window <FocusIn> "if \{\"%W\" == \"$window\"\} \{focus ${window}.e;break\}"
#	bind ${window}.b <FocusIn> "if \{\"%W\" == ${window}.b\} \{focus ${window}.e;break\}"

	bind ${window}_f.lb <Motion> "
	    set tkPriv(y) %y
	    tkListboxMotion %W \[%W index @%x,%y]
            combobox_export ${window}_f.lb ${window}.e
	"

	bind ${window}_f.lb <Leave> "
	    set tkPriv(x) %x
	    set tkPriv(y) %y
	    combobox_autoscan ${window}.e %W
            combobox_export ${window}_f.lb ${window}.e
	"
	bind ${window}_f.lb <Enter> {
	    tkCancelRepeat
	}
	
	bind $tagname <FocusIn> {}
	bind $tagname <Enter> {
	}
	bind $tagname <Leave> {
	}
	bind $tagname <Motion> {
	}
	bind $tagname <ButtonPress>  {
	    foreach q {rootx rooty width height} {
		set $q [winfo $q %W]
	    }
	    if {(%X < $rootx) || (%X > ($rootx+$width)) || (%Y < $rooty) || (($rooty+$height) < %Y)} {
		    combobox_release %W
	    }
	}
	bind $tagname <ButtonRelease> "
	    ${window}.b config -relief raised
	"
	bind $tagname <space> {
	    combobox_release %W
	}
	bind $tagname <Return> {
	    combobox_release %W
	}
	bind $tagname <Escape> {
	    combobox_release %W
	}
	bind $tagname <Up> "
	    tkListboxUpDown %W -1
	    combobox_export ${window}_f.lb ${window}.e
            break
	"
	bind $tagname <Down> "
	    tkListboxUpDown %W 1
	    combobox_export ${window}_f.lb ${window}.e
            break
	"
	bind $tagname <KeyPress> {
#	    combobox_release %W
	}

	proc combobox_export {l e} {
	    if {[set idx [$l curselection ]] != ""} {
		$e delete 0 end
		$e insert 0 [$l get $idx]
	    }
	}

	proc combobox_autoscan {e w} {
	    global tkPriv
	    if {![winfo exists $w]} return
	    set x $tkPriv(x)
	    set y $tkPriv(y)
	    if {$y >= [winfo height $w]} {
		$w yview scroll 1 units
	    } elseif {$y < 0} {
		$w yview scroll -1 units
	    } elseif {$x >= [winfo width $w]} {
		$w xview scroll 2 units
	    } elseif {$x < 0} {
		$w xview scroll -2 units
	    } else {
		return
	    }
	    tkListboxMotion $w [$w index @$x,$y]
	    combobox_export $w $e
	    set tkPriv(afterId) [after 50 combobox_autoscan $e $w]
	}

	proc combobox_release {w} {
	    grab release $w
#	    place forget $w
	    wm withdraw [winfo toplevel $w]
	}

	proc _${window}_ {args} "
	    eval \"combobox_command $window \$args\"
	"

	bind ${window}.e <Return> "break"

	proc combobox_command {window cmd args} {
	    if {$cmd == "append"} {
		eval "${window}_f.lb insert end $args"
	    } elseif {$cmd == "get"} {
		${window}.e get
	    } elseif {$cmd == "ecommand"} {
		bind ${window}.e <Return> "eval [concat $args];break"
	    } else {
		eval "${window}.e $cmd $args"
	    }
	}

	interp alias {} $window {} _${window}_
	
	proc combobox_drop {w listproc} {
	    if {[winfo ismapped ${w}_f]} {
		grab release ${w}_f
#		place forget ${w}_f
		wm withdraw ${w}_f
	    } else {
		if {$listproc != ""} {
		    ${w}_f.lb delete 0 end
		    foreach q [eval $listproc] {
			${w}_f.lb insert end $q
		    }
		}
#		set x1 [expr [winfo rootx ${w}.b]-[winfo rootx ${w}]+[winfo reqwidth ${w}.b]-[winfo reqwidth ${w}_f]]
#		set y1 [expr [winfo rooty ${w}.b]-[winfo rooty ${w}]+[winfo height ${w}.b]]
# This one sets the right side of the down arrow even with the pulldown.
#		set x1 [expr [winfo rootx ${w}.b]+[winfo reqwidth ${w}.b]-[winfo reqwidth ${w}_f]]
		set x1 [expr [winfo rootx ${w}.b]-[winfo reqwidth ${w}_f.lb]]
		set y1 [expr [winfo rooty ${w}.b]+[winfo height ${w}.b]]
#		place ${w}_f -in ${w} -x $x1 -y $y1
		wm geom ${w}_f +$x1+$y1
		wm deiconify ${w}_f
		# place ${w}_f -in [winfo parent ${w}] -x $x1 -y $y1
		raise ${w}_f
		focus ${w}_f.lb
		update 
		grab -global ${w}_f
	    }
	}

	proc combobox_double {cmdproc window y} {
	    grab release ${window}_f
	    ${window}.e delete 0 end
	    ${window}.e insert 0 [${window}_f.lb get [${window}_f.lb nearest $y]]
	    focus ${window}.e
	    combobox_release ${window}_f
	    if {"$cmdproc" != {}} {
		eval $cmdproc $window
	    }
	}
	bind ${window}_f.lb <Double-1> "combobox_double [list $cmdproc] [list $window] %y"
	bind ${window}_f.lb <1> "combobox_double [list $cmdproc] [list $window] %y"
	bind ${window}_f.lb <ButtonRelease-1> "combobox_double [list $cmdproc] [list $window] %y"

	proc combobox_return {cmdproc window} {
	    combobox_export ${window}_f.lb ${window}.e
	    focus ${window}.e
	    combobox_release ${window}_f
	    if {"$cmdproc" != {}} {
		eval $cmdproc $window
	    }
	}
	bind ${window}_f.lb <Return> "combobox_return [list $cmdproc] [list $window]"

	bind ${window}.e <Down> "combobox_drop ${window} [list $listproc]"

#	bind ${window} <Escape> "
#	    focus ${window}.e
#	    place forget ${window}_f
#           break
#	"
#
#	bind ${window}_f.lb <Escape> "
#	    focus ${window}.e
#	    place forget ${window}_f
#           break
#	"

	bind ${window} <Escape> "
	    focus ${window}.e
	    wm withdraw ${window}_f
            break
	"

	bind ${window}_f.lb <Escape> "
	    focus ${window}.e
	    wm withdraw ${window}_f
            break
	"

	bind ${window} <Destroy> "
            if \{\[winfo exists ${window}_f\]\} \{
                destroy ${window}_f
            \}
        "
    
#	bind ${window}.e <Escape> "
#            if \{\[place info ${window}_f\] != \{\}\} \{
#                focus ${window}.e;
#                place forget ${window}_f
#            \}
#        "
	bind ${window}.e <Escape> "
            if \{\[place info ${window}_f\] != \{\}\} \{
                focus ${window}.e;
                wm withdraw ${window}_f
            \}
        "

#	bind ${window} <Configure> "
#            if \{\[place info ${window}_f\] != \{\}\} \{
	#                combobox_drop ${window} [list $listproc]
#            \}
#        "
	bind ${window} <Configure> "
            if \{\[winfo ismapped ${window}_f\]\} \{
                combobox_drop ${window} [list $listproc]
            \}
        "
	if {$listproc != ""} {
	    ${window}_f.lb delete 0 end
	    foreach q [eval $listproc] {
		${window}_f.lb insert end $q
	    }
	}

	if {$args != ""} {
	    foreach q $args {
		${window}_f.lb insert end $q
	    }
	}
    bind ${window}_f.lb <Configure> \
	    "combobox_config ${window}_f.lb ${window}_f.sb"
    }
}

# remove scrollbar and shrink as needed

proc combobox_config {listbox scrollbar} {
    set items [$listbox index end]
    set size [$listbox cget -height]
    if {$items <= $size} {
    	pack forget $scrollbar
    	$listbox configure -height $items
    } else {
	pack $scrollbar -side right -fill y
    }
}

# combobox .cb "lsort \[info comm *\]"

# wm geometry . 300x300

# pack .cb

# .cb insert "Turkeybutt"

# .cb ecommand {.cb insert \[.cb get\]}

#bind all <Motion> {
#  puts "%W %X %Y %x %y motion"
#}
#
#bind .cb <Enter> {
#  puts "Entering .cb"
#}
# 
#bind .cb <Leave> {
#  puts "Leaving .cb"
#}