# This software is distributed under the Lesser General Public License
#
# widgets/combobox.tcl
#
# combobox widget
#
#------------------------------------------ CVS
#
# CVS Headers -- The following headers are generated by the CVS
# version control system. Note that especially the attribute
# Author is not necessarily the author of the code.
#
# $Source: /home/br/CVS/graphlet/lib/graphscript/widgets/combobox.tcl,v $
# $Author: forster $
# $Revision: 1.13 $
# $Date: 1999/03/01 16:58:39 $
# $Locker:  $
# $State: Exp $
#
#------------------------------------------ CVS
#
# (C) University of Passau 1995-1999, Graphlet Project
#     Authors: Michael Himsolt, Michael Forster

package provide Combobox 1.0

namespace eval Combobox {

    namespace export create

    image create bitmap ::Combobox::down -data {
	\#define _width 8
	\#define _height 4
	static unsigned char _bits[] = {
	    0xff, 0x7e, 0x3c, 0x18
	};
    }

    Widget::create_type Combobox \
	-options {
	    -command	command		Command		{}
	    -value	value		Value		{}
	    -values	values		Values		{}
	    -regexp	regexp		Regexp		{}
	    -height	height		Height		10
	} \
	-resources {
	    borderWidth			2
	    relief			sunken
	    highlightThickness		1
	    value.borderWidth		0
	    value.highlightThickness	0
	    but.relief			raised
	    but.borderWidth		2
	    but.highlightThickness	0	       
	    but.takeFocus		0
	    but.image			::Combobox::down
	} \
	-forward_options {
	    frame {
		highlightbackground highlightthickness relief
	    }
	    value {
		cursor exportselection font 
		highlightbackground insertbackground insertborderwidth
		insertofftime insertontime insertwidth justify relief
		selectbackground selectborderwidth selectforeground
		show takefocus textvariable width xscrollcommand
	    }
	    { value but } { state foreground background }
	    { frame but } { bd borderwidth }
	} \
	-forward_commands {
	    value {
		bbox delete get icursor index insert scan selection xview
	    }
	} \
	-commands {
	    add		Combobox::add
	    assign	Combobox::assign
	    close	Combobox::close_dropdown
	    open	Combobox::open_dropdown
	    value	Combobox::value
	}

    proc create { cb args } {

	# creation

	Widget::create Combobox $cb

	pack [button $cb.but] \
	    -side right \
	    -fill y -expand false
	pack [entry $cb.value] \
	    -side left \
	    -fill both -expand true
	

	# initialization
	
	eval Widget::init Combobox $cb $args
	$cb insert 0 [$cb cget -value]
	
	# bindings

	bind $cb.value <Return>	[namespace code "ev_value_Return $cb"]
	bind $cb.value <Down>	[namespace code "$cb open"]
	
	bind $cb.but <Button-1>	[namespace code "ev_Button-1 $cb"]

	# intercept value command
	
	rename $cb.value ::$cb.value@
	proc ::$cb.value { args } \
	    "uplevel [namespace current]::ev_value_cmd $cb \$args"
	bind $cb.value <Destroy> "rename ::$cb.value {}"

	return $cb
    }
    
    proc add { cb value } {
	
	set values [$cb cget -values]
	
	lappend values $value
	
	$cb configure -values $values
    }
    
    proc assign { cb value } {
	$cb delete 0 end
	$cb insert 0 $value
    }

    proc value { cb } {
	return [$cb get]
    }

    proc open_dropdown { cb } {

	# create widgets
	
	set bd [$cb cget -bd]
	set bg [$cb cget -background]
	set font [$cb cget -font]
	
	set drop [toplevel $cb.drop]

	set sb [scrollbar $drop.sb \
		    -command "$drop.lb yview" \
		    -orient vertical \
		    -takefocus 0 \
		    -highlightthickness 0\
		   ]
	
	set height    [$cb cget -height]
	set numvalues [llength [$cb cget -values]]
	if { $numvalues > $height } {
	    pack $sb \
		-side right \
		-fill y -expand false
	} else {
	    set height $numvalues
	}
	
	pack [listbox $drop.lb \
		  -font $font \
		  -bg $bg \
		  -yscrollcommand "$drop.sb set" \
		  -highlightthickness 0 \
		  -width 0 \
		  -height $height \
		 ] \
	    -side left \
	    -fill both -expand true

	# improve look on individual platforms
	
	global tcl_platform
	if { $tcl_platform(platform) == "windows" } {
	    
	    $drop configure \
		-relief solid \
		-bd 1
	    
	    $drop.lb configure \
		-bd 0 \
		-selectborderwidth 0
	    
	} else {
	    
	    $drop configure \
		-relief raised \
		-bd $bd
	    
	    $drop.sb configure \
		-bd $bd \
		-width 10
	    
	    $drop.lb configure \
		-bd $bd
	}

	# insert values and select current

	foreach value [$cb cget -values] {
	    $drop.lb insert end $value

	    if { $value == [$cb get] } {
		$drop.lb activate end	
		$drop.lb selection set end	
	    }
	}
	if { [$drop.lb curselection] == {} } {
	    $drop.lb selection set 0
	}
	$drop.lb see active

	# dropdown geometry
	
	set ht [$cb cget -highlightthickness]
	set drop_bd [$drop cget -bd]
	
	set x [expr [winfo rootx $cb] + $ht]
	set y [expr [winfo rooty $cb] - $ht + [winfo height $cb]]
	set w [expr [winfo width $cb] - 2*$ht]
	set h [expr [winfo reqheight $cb.drop.lb] + 2*$drop_bd]

	wm geometry $drop ${w}x${h}+${x}+${y}

	# window manager settings
	
	wm overrideredirect $drop 1
	focus $drop.lb
	update idletasks
	grab -global $drop

	# bindings
	
 	bind $drop <ButtonPress>	[namespace code "ev_ButtonPress $cb %W"]

	bind $drop.lb <Motion>		[namespace code "ev_Motion $cb %x %y"]

 	bind $drop.lb <Key-Escape>	[namespace code "$cb close; break"]

 	bind $drop.lb <ButtonRelease-1>	[namespace code "select $cb; break"]
	bind $drop.lb <space>		[namespace code "select $cb; break"]
	bind $drop.lb <Return>		[namespace code "select $cb; break"]
    }

    proc close_dropdown { cb } {
	destroy $cb.drop
    }

    #================================================== Event handling
    
    proc ev_Button-1 { cb } {
	
	if [winfo exists $cb.drop] {
	    $cb close
	} elseif { [$cb cget -state] != "disabled" } {
	    $cb open
	}

	return -code break
    }

    proc ev_Motion { cb x y } {
	$cb.drop.lb selection clear 0 end
	$cb.drop.lb selection set @$x,$y
	$cb.drop.lb activate @$x,$y
    }
    
    proc ev_ButtonPress { cb W } {
	if { $W == "$cb.drop" } {
	    $cb close
	}
    }
    
    proc ev_value_Return { cb } {
	if { [is_valid $cb [$cb get]] } {
	    uplevel \#0 [$cb cget -command]	
	}
    }

    proc ev_value_cmd { cb args } {

	set cmd $cb.value@
	set value [$cmd get]

	switch [lindex $args 0] {
	    insert {
		set index [$cmd index [lindex $args 1]]
		
		append newvalue [string range $value 0 [expr $index-1]]
		append newvalue [lindex $args 2]
		append newvalue [string range $value $index end]
	    }
	    delete {
		set index1 [$cmd index [lindex $args 1]]
		set index2 [lindex $args 2]

		if { $index2 == {} } {
		    set index2 $index1
		} else {
		    set index2 [$cmd index $index2]
		}

		append newvalue [string range $value 0 [expr $index1-1]]
		append newvalue [string range $value [expr $index2+1] end]
	    }
	    default {
		set newvalue $value
	    }
	}

	if { $newvalue == {} || [is_valid $cb $newvalue] } {
	    return [uplevel ::$cb.value@ $args]
	} else {
	    return {}
	}
    }

    #================================================== Utilities
    
    proc select { cb } {
	
	$cb delete 0 end
	$cb insert 0 [$cb.drop.lb get active]

	uplevel \#0 [$cb cget -command]
	
	$cb close
    }

    proc is_valid { cb value } {

	set regexp [$cb cget -regexp]

	if { $regexp != {} } {
	    return [regexp -- $regexp $value]
	}
	
	return 1
    }
}

#---------------------------------------------------------------------------
#   Set emacs variables
#---------------------------------------------------------------------------
# ;;; Local Variables: ***
# ;;; mode: tcl ***
# ;;; tcl-indent-level: 4 ***
# ;;; End: ***
#---------------------------------------------------------------------------
#   end of file
#---------------------------------------------------------------------------
