# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# combo.tcl - A combo box widget.
# Copyright (C) 1998 Cygnus Solutions.

set Combo_Info(screen_width)  [winfo screenwidth .]
set Combo_Info(screen_height) [winfo screenheight .]
#############################################################################
##  CLASS for TreeWidget with tab stop support                             ##
#############################################################################
itcl_class Combo& {
	constructor {config} {
		global sn_path
		
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		set combo $this
		set frame $this
		set entry $this.entry
		set arrow $this.arrow
		set menu  $arrow.m
		set tree  $menu.tree
		set menu_first 1
		
		if {$balloon != "" && $entryballoon == ""} {
			set entryballoon $balloon
		}
		if {$balloon != "" && $buttonballoon == ""} {
			set buttonballoon $balloon
		}
		
		if {$label != "none"} {
			set cmd [list @@label $this.label \
				-text $label \
				-underline $underline]
			if {$labelwidth != -1} {
				lappend cmd -width $labelwidth
			}
			if {$anchor != ""} {
				lappend cmd -anchor $anchor
			}
			eval $cmd
			pack $this.label \
				-side left \
				-padx 1 \
				-pady 1
		}
		set flags ""
		if {$textvariable != ""} {
			lappend flags -textvariable $textvariable
		}
		if {$width > 0} {
			lappend flags -width $width
		}
		eval @@entry $entry $flags \
				-exportselection $exportselection \
				-state $state
		@@bind $entry <Enter>  "$this entry_enter"
		@@bind $entry <Leave>  "$this entry_selection"
		@@bind $entry <Return> "$this entry_selection 1; $this entry_enter; break"
		@@bind $entry <Tab> {focus [tk_focusNext %W]}
		@@bind $entry <Shift-Tab> {focus [tk_focusPrev %W]}
		if {$entryballoon != ""} {
			balloon_bind_info $entry $entryballoon
		}
		pack $entry -side left -fill both -expand $expand
		
		menubutton $arrow \
			-relief raised \
			-image arrow_image \
			-menu $menu \
			-state $state \
			-takefocus 1 \
			-highlightthickness 1
		@@bind $arrow <Tab> {focus [tk_focusNext %W]}
		@@bind $arrow <Shift-Tab> {focus [tk_focusPrev %W]}
		if {$buttonballoon != ""} {
			balloon_bind_info $arrow $buttonballoon
		}
		pack $arrow -side right -fill y

		menu $menu \
			-tearoff $tearoff \
			-tearoffcommand "$this menu_tearoff" \
			-postcommand "$this menu_place" \
			-type tearoff
		wm overrideredirect $menu 1
			
		Tree& $tree \
			-withframe $withframe \
			-sort $sort \
			-filter $filter \
			-bitmapspace $bitmapspace \
			-contents $contents
		set treew [$tree tree]
		$tree bind <B1-ButtonRelease> "$this menu_selection"
		$tree bind <space> "+$this entry_travers; $this menu_unpost"
		$tree bind <Return> [$tree bind <space>]
		$tree bind <Escape> "$this menu_unpost"
		
		#apply focus input to the treetable, very important
		bind_focus_enter $treew {catch {focus %W}}
		
		#Bind traversal keys
		@@bind $entry <Up>    "tkListboxUpDown $treew -1;    $this entry_travers"
    		@@bind $entry <Down>	 "tkListboxUpDown $treew 1;     $this entry_travers"
		@@bind $entry <Prior>	"$treew yview scroll -1 pages; $treew activate @0,0; $this entry_travers"
		@@bind $entry <Next>  "$treew yview scroll 1 pages;  $treew activate @0,0; $this entry_travers"
	}
	destructor {
		catch {$tree delete}
		foreach v [@@info globals "$combo-*"] {
			catch {uplevel #0 unset $v}
		}
	}
	method config {config} {
	}
	
	method menu_popup {} {
		tkMbPost $arrow 0 0
	}
	protected menu_first 0
	method menu_place {} {
		global Combo_Info
		global tcl_platform

		wm withdraw $menu
		set x [winfo rootx $entry]
		set y [expr [winfo rooty $entry] + [winfo height $entry]]
		if {$combowidth == 0} {
			set ww [expr [winfo width $entry] + [winfo width $arrow]]
		} else {
			set ww $combowidth
		}
		if {$comboheight == 0} {
			set hh [winfo height $menu]
		} else {
			set hh $comboheight
		}
		if {$hh < 200} {
			set hh 200
		}
		
		#verify if we have tearoff managment
		if {$tearoff} {
			set toff 20
		} else {
			set toff 0
		}
		
		#place extended widget if exists
		if {$extended != ""} {
			set extw [winfo reqwidth $extended]
			set exth [winfo reqheight $extended]
			if {$hh < $exth} {
				set hh [expr $exth + $bd*2 - $toff]
			}
			place $extended \
					-x [expr $ww-$bd] \
					-y [expr $bd + $toff] \
					-width $extw \
					-height [expr $hh - $bd*2 - $toff]
		} else {
			set extw 0
			set exth 0
		}
		
		#place tree widget
		place $tree \
				-x $bd \
				-y [expr $bd + $toff] \
				-width [expr $ww - $bd*2] \
				-height [expr $hh - $bd*2 - $toff]
		
		#correct width to extended widgets
		set ww [expr $ww + $extw]
		
		#don't display a part of the window outside the screen
		if {[expr $x + $ww] > $Combo_Info(screen_width)} {
			set x [expr $Combo_Info(screen_width) - $ww]
		}
		if {[expr $y + $hh] > $Combo_Info(screen_height)} {
			set y [expr $Combo_Info(screen_height) - $hh]
		}
		
		set sel [$treew curselection]
		if {$sel == "" || $menu_first} {
			set sel "-top 0"
		}
		
		if {$postcommand != ""} {
			eval $postcommand
		}
		#when we don't raise the menu window, it isn't viewed
		#in MS Windows.
		if {$tcl_platform(platform) == "windows"} {
			after idle "
				wm overrideredirect $menu 1
				wm deiconify $menu
				wm geometry $menu ${ww}x${hh}+${x}+${y} 
				raise $menu 
				focus $treew
				after idle \"eval $treew see $sel\"
				if \{$menu_first\} \{
					after idle \"Tree& @@ resize_widget $treew\"
				\}"
		} else {
			after idle "
				wm overrideredirect $menu 1
				wm geometry $menu ${ww}x${hh}+${x}+${y} 
				wm deiconify $menu
				raise $menu
				focus $treew
				after idle \"eval $treew see $sel\"
				if \{$menu_first\} \{
					after idle \"Tree& @@ resize_widget $treew\"
				\}"
		}
		set menu_first 0
	}
	
	method menu_selection {} {
		set sel [lindex [$treew curselection] 0]
		if {$sel != ""} {
			set txt [$treew get $sel]
			$entry delete 0 end
			$entry insert 0 $txt
		}
		tkMenuUnpost $menu
		invoke_command
	}
	
	method menu_tearoff {m new_mnu} {
	}
	
	method menu_unpost {} {
	    tkMenuUnpost $menu
	}
	
	method entry_enter {} {
		set entry_value [$entry get]
	}
	
	#if mode is true the selectcommand will be invoked
	#else it is only invoked when the value is changed
	method entry_selection {{mode 0}} {
		#Verify first if
		#the user has entered anything to look for.
		set txt [$entry get]
		if {$mode == 0 && ($txt == "" || $entry_value == $txt)} {
			return
		}
		
		if {$postentrycommand != ""} {
			eval $postentrycommand
		}
		
		#if readonly, only text from the list can be the
		#content of the entry widget.
		if {$readonly} {
			set idx [$treew search -begins -nocase -- $txt 0]
			
			#it must be exact matching
			if {$idx != ""} {
				set tt [$treew get $idx]
				if {$tt != $txt} {
					$treew selection clear 0 end
					$treew selection set $idx
					$treew activate $idx
					$treew see $idx
					set idx ""
				}
			}
			#if the selection is not found, display the first
			#entry
			if {$idx == ""} {
				set sel [lindex [$treew curselection] 0]
				if {$sel == ""} {
					if {[$treew size] > 0} {
						set sel 0
					} else {
						set sel -1
					}
				}
				$entry delete 0 end
				if {$sel != -1} {
					$entry insert 0 [$treew get $sel]
				}
			}
		}
		invoke_command
	}
	method entry_travers {} {
		$treew selection clear 0 end
		$treew selection set active
		set sel [lindex [$treew curselection] 0]
		if {$sel == ""} {
			if {[$treew size] > 0} {
				set sel 0
			} else {
				set sel -1
			}
		}
		if {$sel != -1} {
			$entry delete 0 end
			$entry insert 0 [$treew get $sel]
		}
		invoke_command
	}
	method invoke_command {} {
		if {$selectcommand != ""} {
			set entry_value [$entry get]
			eval $selectcommand [list $entry_value]
		}
	}
	
	#delete all contents in the combobox
	method clear {} {
		$tree config -contents ""
		clearentry
	}
	
	#delete text from entry
	method clearentry {} {
		$entry delete 0 end
	}
	
	#get text in the entry widget
	method getentry {} {
		return [$entry get]
	}
	
	#select and return text from combobox by a given number
	method get {num} {
		$treew selection clear 0 end
		$treew selection set $num
		$treew activate $num
		$treew see $num
		$entry delete 0 end
		$entry insert 0 [$treew get $num]
		return [$treew get $num]
	}
	
	#select text by a given number
	method select {num} {
		$treew selection clear 0 end
		$treew selection set $num
		$treew activate $num
		$treew see $num
		$entry delete 0 end
		$entry insert 0 [$treew get $num]
	}
	
	#select combobox entry that match a given text
	#if offset is greater than 0 the item with this
	#offset is selected
	method selecttext {txt {off 0}} {
		set idx [$treew search -exact -- $txt 0]
		if {$idx == ""} {
			set idx 0
		}
		set idx [expr $idx + $off]
		if {$idx != "" && $idx != -1} {
			$treew selection clear 0 end
			$treew selection set $idx
			$treew see $idx
		}
		set oldstate [$entry cget -state]
		if {$oldstate != "normal"} {
			$entry config -state normal
		}
		$entry delete 0 end
		$entry insert 0 $txt
		if {$oldstate != "normal"} {
			$entry config -state $oldstate
		}
	}
	
	#return the offset of the selected text if there
	#is more than one entry with the same text
	method offset {} {
		set sel [$treew curselection]
		if {$sel == ""} {
			return 0
		}
		set txt [$treew get $sel]
		set idx [$treew search -exact -- $txt 0]
		if {$sel != "" && $idx != ""} {
			return [expr $sel - $idx]
		} else {
			return 0
		}
	}
	
	method disable {} {
		$arrow config -state disabled
		$entry config -state disabled
	}
	
	#enable/disable combobox.
	method combobox {state} {
		$arrow config -state $state
	}
	
	method enable {} {
		$arrow config -state normal
		$entry config -state normal
	}
	
	method combo {} {
		return $combo
	}
	#tree class
	method tree {} {
		return $tree
	}
	#tree widget
	method treew {} {
		return $treew
	}
	method arrow {} {
		return $arrow
	}
	method entry {} {
		return $entry
	}
	method mnu {} {
		return $menu
	}
	method see {num} {
		$tree see $num
	}
	method contents {cnt} {
		#$tree config -contents $cnt
		$tree setcontents $cnt
		$tree contents
	}
	method insert args {
		eval $treew insert $args
	}
	
	protected frame ""
	protected combo ""
	protected menu ""
	protected entry ""
	protected arrow ""
	protected tree ""
	protected treew ""
	
	protected entry_value ""
	
	public bd 3
	public label "none"
	public selectcommand ""
	public withframe 0
	public extended ""
	public postcommand ""
	public postentrycommand ""
	public readonly 1
	public combowidth 0
	public comboheight 0
	public filter "*"
	public bitmapspace 0
	public tearoff 0
	public exportselection 0
	public width 0 {
		if {[winfo exists $entry]} {
			$entry config -width $width
		}
	}
	public textvariable "" {
		if {$textvariable != "" && [winfo exists $entry]} {
			$entry config -textvariable $textvariable
		}
	}
	public expand "n" {
		if {$expand != "" && [winfo exists $entry]} {
			$entry config -expand $expand
		}
	}
	public contents "" {
		if {[winfo exists $tree]} {
			#$tree config -contents $contents
			$tree setcontents $contents
			$tree contents
			#contents is unneeded
			unset contents
		}
	}
	public state "normal" {
		if {![winfo exists $tree]} {
			return
		}
		$arrow config -state $state
		$entry config -state $state
	}
	public sort "-increasing"
	public anchor ""
	public labelwidth -1
	public underline -1
	public entryballoon ""
	public buttonballoon ""
	public balloon ""
}


