# 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.
# 
itcl_class Selector& {
	inherit Tree&

	constructor {config} {
		@@global $this-e-name

		set cmd ""
		foreach c $config {
			append cmd "-$c {[virtual set $c]} "
		}
		eval Tree&@@constructor \
			-withframe y \
			-exportselection $exportselection \
			-have_filter 0 \
			$cmd
		

		if {$exec_button == ""} {
			set exec_button $this.button_0
		}

		#entry for selected directory/file
		if {$direct_ent != ""} {
			set direct_ent $this.direct_ent

			entry $direct_ent \
				-relief ridge \
				-borderwidth 2\
				-exportselection 0\
				-textvariable $this-e-name

			@@bind $direct_ent <KeyPress> \
				"[info class] @@ check_input $direct_ent $exec_button"
			bind_focus_enter $direct_ent {focus %W}

			if {$must_exist && $entrycommand != ""} {
				@@bind $direct_ent <Return> "eval $entrycommand %W; break"
			}

			pack $direct_ent -before $lframe\
				-side top -expand n -fill x -padx 2 -pady 2

			@@focus $direct_ent
			@@set $this-e-name $advised
			$this direct_ent select range 0 end
		}

		frame $this.filter
		label $this.filter.label -text [get_indep String Pattern]

		set entry $this.filter.entry
		entry $entry -relief sunken -exportselection 0\
		    -width $filter_width

		$entry insert end $filter
		$entry icursor 0

		@@bind $entry <Return> "$this fill; break"

		pack $this.filter.label -side left
		pack $entry -side left -fill x -expand y -padx 3

		pack $this.filter -before $lframe\
			-side bottom -expand n -fill x

		if {[string compare $contents ""] != 0} {
			$this fill 0
		}

		$this bind <ButtonRelease-1> "+focus %W;$this set_selection"
	}

	destructor {
		catch {destroy $this.filter}

		foreach v [@@info globals "$this-*"] {
			catch {uplevel #0 unset $v}
		}
	}

	method set_selection {} {
		if {$direct_ent != ""} {
			global $this-e-name
			@@set $this-e-name [$this marked]
			$direct_ent selection range 0 end
		}

		return [$this marked]
	}

	public exec_button ""

	method fill {{bsy 1}} {
		if {![winfo exists $this] || ![winfo exists $entry]} {
			return
		}

		set filter [$entry get]
		if {[string compare $filter ""] == 0} {
			set filter "*"
			$entry insert end "*"
			$entry icursor 0
		}

		if {[string compare $contents ""] == 0} {
			$this delete_tk 0 end
			
			return
		}

		if {$bsy} {
			watch y
		}
		set act_idx [$this index active]
		$tree delete 0 end

		if {$eval} {
			set cmd $contents;		# It contains a tcl command.

			regsub {%f} $cmd $filter cmd

			if {$sort != ""} {
				if {$nocase} {
					if {$imagecmd == ""} {
						$tree insert end list [@@lsort -command sn_compare $sort [@@eval $cmd]]
					} else {
						$tree insert end list [@@lsort -command sn_compare $sort [@@eval $cmd]] $imagecmd $image
					}
				} else {
					if {$imagecmd == ""} {
						$tree insert end list [@@lsort $sort [@@eval $cmd]]
					} else {
						$tree insert end list [@@lsort $sort [@@eval $cmd]] $imagecmd $image
					}
				}
			} else {
				if {$imagecmd == ""} {
					$tree insert end list [@@eval $cmd]
				} else {
					$tree insert end list [@@eval $cmd] $imagecmd $image
				}
			}
		} else {
			if {[string compare $filter "*"] != 0} {
				if {$nocase} {
					set flt [nocase_glob_pattern $filter]
				} else {
					set flt $filter
				}
				if {$imagecmd == ""} {
					$tree insert end list [lmatch $contents $flt]
				} else {
					$tree insert end list [lmatch $contents $flt] $imagecmd $image
				}
			} else {
				if {$imagecmd == ""} {
					$tree insert end list $contents
				} else {
					$tree insert end list $contents $imagecmd $image
				}
			}
		}

		$tree activate $act_idx

		if {$bsy} {
			watch n
		}
	}

	proc nocase_glob_pattern {flt} {
		if {[string compare $flt "*"] == 0} {
			return $flt
		}
	    for {set c 0; set brace_lev 0; set m ""; set glb_pat "";\
			set flt [string tolower $flt]} \
			{$c < [string length $flt]} {incr c} {
	
			set ch [string index $flt $c]
			switch -glob -- $ch {
			{[A-Za-z]} {
				if {$brace_lev <= 0} {
				    append m \[ [string tolower $ch] \
						[string toupper $ch] \]
				} else {
					append glb_pat $ch
				}
			    }
			{\[}	{
				append m \[
				set glb_pat ""
				incr brace_lev
			    }
			{\]}	{
				for {set k 0} {$k < [string length $glb_pat]} \
				    {incr k} {
				    set cc [string index $glb_pat $k]
				    set nc [string index $glb_pat [expr $k + 1]]
				    append m [string tolower $cc]
				    if {[string compare $nc "-"] == 0} {
					incr k 2
					set nc [string index $glb_pat $k]
					append m "-" [string tolower $nc] \
					    [string toupper $cc] "-" [string toupper $nc]
				    } else {
					append m [string toupper $cc]
				    }
				}
				set glb_pat ""
				append m \]
				incr brace_lev -1
			}
			{\\}	{
				incr c
				append m "\\" [string index $flt $c]
			    }
			default {
				if {$brace_lev <= 0} {
				    append m $ch
				} else {
				    append glb_pat $ch
				}
			    }
			}
		}
		return $m
	}

	method marked {{str 1}} {
		set sel [$this curselection]

		if {$str} {
			set val ""
			foreach s $sel {
				lappend val [$this get $s]
			}
			return $val
		} else {
			return $sel
		}
	}

	method direct_ent {args} {
		if {$direct_ent != ""} {
			return [eval $direct_ent $args]
		}
	}

	method values {} {
		return [$this get 0 end]
	}

	method filter {{pattern ""}} {
	    if {[string compare $pattern ""] == 0} {
		return $filter
	    }
	    $this config -filter $pattern
	}

	proc check_input {entry button} {
		if {[string compare [string trim [$entry get]] ""] == 0} {
			set state disabled
		} else {
			set state normal
		}
		$button config -state $state
	}

	public contents {} {
		if {[winfo exists $this]} {
			set y [$this nearest 0]

			if {!$eval && $sort != ""} {
				if {$nocase} {
					set contents [@@lsort $sort -command sn_compare $contents]
				} else {
					set contents [@@lsort $sort $contents]
				}
			}

			$this fill 0
# This is necessary, otherwise the listbox scrolls
# back to the top.
			$this yview $y
		}
	}

	public filter {*} {
		if {[winfo exists $this]} {
			$entry delete 0 end
			$entry insert end $filter
			$entry icursor 0

			if {[string compare $contents ""] != 0} {
				if {$eval} {
					set bsy 1
				} else {
					set bsy 0
				}
				$this fill $bsy
			}
		}
	}

	public script {}

	protected entry {}
	public sort {-increasing}
	public direct_ent {}
	public advised {}
	public exportselection 0 {
		if {[winfo exists $this]} {
			$this config_tk -exportselection $exportselection
		}
	}
	public nocase 1
	public filter_width 22 {
		if {[winfo exists $entry]} {
			$entry config -width $filter_width
		}
	}
	protected imagecmd ""
	public eval 0
	public image "" {
		set imagecmd "-image"
	}
	public bitmap "" {
		set imagecmd "-bitmap"
		set image $bitmap
	}
	public must_exist 0
	public entrycommand ""
}

itcl_class TopSelector& {
	inherit Selector& Toplevel&

	constructor {config} {
		global $this-name
		@@set $this-name ""

		Toplevel&@@constructor

		Selector&@@constructor -scroll "bottom default"

		sn_motif_buttons $this\
			bottom 0\
			[get_indep String ok]\
			[get_indep String Search]\
			[get_indep String cancel]

		bind <1> "+$this.button_0 config -state normal"
		bind <Triple-1> { }
		bind <Double-1> "$this.button_0 invoke; break"
		bind <Return> "$this.button_0 invoke; break"
		bind <space> "$this.button_0 config -state normal; $this.button_0 invoke; break"

		if {[string compare $advised ""] == 0} {
			set state disabled
		} else {
			set state normal
		}
		$this.button_0 configure -state $state\
			-command "$this Terminate"

		$this.button_1 configure\
			-command "$this fill"

		$this.button_2 configure\
			-command "$this delete"

		pack configure $this.button -before $this.filter\
			-side bottom -expand n -fill x

		if {$direct_ent != ""} {
			@@bind $direct_ent <KeyPress> \
				"[info class] @@ check_input $direct_ent $this.button_0"
		}
		$this minsize 25 1
	}

	method Terminate {} {
		global $this-name

		if {!$must_exist && $direct_ent != ""} {
			@@set $this-name [string trim [$this direct_ent get]]
		} else {
			@@set $this-name [$this marked]
		}

		if {[string compare $script ""] != 0} {
			set scr $script
			set name [set $this-name]
			$this delete

			eval $scr $name
		}
	}

	method Take {{bsy 1}} {
		global $this-name

		if {$bsy} {
			catch {$this grab set}
		}
		tkwait variable $this-name

		if {$bsy} {
			catch {$this grab release}
		}

		if {[catch {set name [set $this-name]}]} {
			set name ""
		}

		catch {$this delete}

		return $name
	}

	public script {}
}

