#@package: listboxes Listbox ToplevelListbox DatabaseListbox DatabaseSearchListbox

package require Itcl
package require Tk

#
# Copyright (C) 1992-1997 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

#
# Handy Little Listbox Class
#
# Copyright (C) 1996 NeoSoft, All Rights Reserved
#
# This defines a listbox class which has methods to add
# to a listbox and run callbacks when items are selected.
#
# Most nice about it is that it can keep some data in
# parallel to the listbox but squirreled away, not
# in the box itself.  This way nasty-but-essential things
# like indexes and pointers and stuff can be kept out
# of sight.
#
# $Id
#

require TSV

itcl_class Listbox {
    #
    # Set up a window that has a listbox in it,
    # with a couple of useful buttons.
    #
    # Listbox listboxname -frame framename [-title title] 
    #    [-callback callback_routine] [-indexCallback index_callback_routine] 
    #    [-saveCallback save_callback] [-geometry nxm]
    #
    constructor {config} {
	set w $frame

	if {$saveCallback != ""} {
	    frame $w.saveframe
	    pack $w.saveframe -fill x
	    button $w.saveframe.savebutton -text "Save" -command $saveCallback
	    pack $w.saveframe.savebutton -side left
	}

	set boxframe $w.boxframe
	frame $boxframe
	set box $boxframe.box
	scrollbar $boxframe.bar -relief sunken -command "$box yview"
	listbox $box -yscroll "$boxframe.bar set" -relief sunken \
	    -setgrid 1 -geometry $geometry
	pack $boxframe.bar -side right -fill y
	pack $box -side left -expand yes -fill both

	pack $boxframe -side top -expand yes -fill both

        bind $box <Double-1> "$this select"
    }

    destructor {
	catch {destroy $w}
    }

    method configure {config} {
    }

   #
   # empty out the listbox by deleting all the lines in it
   #
    method empty {} {
	$box delete 0 end
    }

    #
    # return the number of lines in the listbox
    #
    method size {} {
	return [$box size]
    }

    #
    # return 1 if the listbox is empty, else 0
    #
    method isempty {} {
	return [expr [size] == 0]
    }

    #
    # return a line within the listbox by index
    #
    method get {index} {
	return [$box get $index]
    }

    #
    # set a line in the listbox
    #
    method setf {index line} {
	$box insert $index $line
	$box delete [expr $index + 1]
	return
    }

    #
    # save contents of listbox to a file
    #
    method save {fileName} {
	set fp [::open $fileName w]
	set size [size]
	for {set i 0} {$i < $size} {incr i} {
	    puts $fp [get $i]
	}
	::close $fp
    }

    #
    # Method to add an entry to the listbox.
    #
    # Arguments are the text to go into the listbox, and the
    # data associated with the text that isn't to be displayed,
    # i.e. a byte offset or something like that.
    #
    method add {text hidden} {
	set hiddenData([size]) $hidden
	$box insert end $text
    }

    #
    # Method to perform callbacks on all the selected items.
    #
    method select {} {
	if {$callback != ""} {
	    foreach index [$box curselection] {
		set text [get $index]
		eval $callback [list $text] [list $hiddenData($index)]
	    }
	}

	if {$indexCallback != ""} {
	    foreach index [$box curselection] {
		eval $indexCallback $index
	    }
	}
    }

    #
    # remove an item from the box, by index.
    #
    method remove {index} {
	$box delete $index
    }

    protected box
    protected hiddenData
    protected w

    public title
    public callback ""
    public indexCallback ""
    public saveCallback ""
    public frame
    public geometry "20x10"
}

#
# This listbox builds on the previous one... It creates a
# listbox in a toplevel window, and adds a "-dismissCommand" that
# can be specified to do something special if the window is dismissed.
#
# In any case the dismiss button is created, if the -dismissCommand
# is not specified, it just deletes the window.
#
itcl_class ToplevelListbox {
    inherit Listbox

    constructor {config} {
	set w $windowName
	build_display
    }

    destructor {
	Listbox::destructor
	catch {destroy $w}
    }

    method build_display {config} {
	catch {destroy $w}
	toplevel $w
	wm minsize $w 1 1

	frame $w.keys
	pack $w.keys -fill x

	button $w.keys.dismiss -text "Dismiss" -command "$this dismiss"
	pack $w.keys.dismiss -side left

	set boxframe $w.boxframe
	frame $boxframe
	Listbox::constructor -frame $boxframe
	pack $w.boxframe -side top -expand yes -fill both
    }

    method dismiss {} {
	eval $this $dismissCommand
    }

    method hide {} {
	wm withdraw $w
    }

    method unhide {} {
	wm deiconify $w
    }

    protected w

    public windowName ".toplevel_listbox"
    public dismissCommand "delete"
}

#
# Superclass containing a TSV database and a toplevel listbox.
#
itcl_class DatabaseListbox {
    inherit ToplevelListbox TSV

    constructor {config} {
	ToplevelListbox::constructor
	TSV::constructor
    }

    method query {arrayName fields expression} {
	empty
	upvar $arrayName x
	TSV::query x $fields $expression \
	    "$this DatabaseListbox::record_matched [list $fields]"
    }

    method record_matched {fields object offset arrayName} {
	upvar $arrayName x

        set result ""
	foreach fieldName $fields {
	    lappend result $x($fieldName)
	}
	add $result [location_of_last_record]
    }
}

#
# Superclass containing a TSV database index search and a toplevel listbox.
#
itcl_class DatabaseSearchListbox {
    inherit TSVsearcher DatabaseListbox

    constructor {config} {
	DatabaseListbox::constructor
	TSV::constructor
	TSVsearcher::constructor
	build_searchframe $windowName
    }

    method matches {nMatches} {
	$matchframe.matches configure -text $nMatches
    }

    method searchtext {text} {
	$searchframe.entry delete 0 end
	$searchframe.entry insert 0 $text
    }

    method build_searchframe {w} {
	set searchframe $w.searchframe
	frame $searchframe
	pack $searchframe -side top -fill x

	button $searchframe.button -text "Search" \
	    -command "$this search_from_entry"
	pack $searchframe.button -side left

	entry $searchframe.entry -width 20 -relief sunken
	pack $searchframe.entry -side left -fill x

	set matchframe $w.matchframe
	frame $matchframe
	pack $matchframe -side top -fill x

	label $matchframe.label -text "Matches"
	pack $matchframe.label -side left

	label $matchframe.matches -width 5 -text 0 -relief raised
	pack $matchframe.matches -side left

	bind $searchframe.entry <Return> "$this search_from_entry"
    }

    method search_from_entry {} {
	search [$searchframe.entry get] 0
    }

    method search {pattern {searchtextUpdate 1}} {
	if {$searchtextUpdate} {searchtext $pattern}
	empty
	matches "-----"
	update
	TSVsearcher::search *$pattern* var {$this DatabaseSearchListbox::record_matched $var} -glob
	matches [size]
    }

    method record_matched {key} {
	add $key [locate $key]
    }

    protected searchframe
    protected matchframe
}

