
#@package: boxwindow list_listbox_subwindow

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.

#
# $Id: boxwindow.tcl,v 1.1.1.1 1999/03/31 20:34:39 damon Exp $
#

#
#
# set result [list_listbox_subwindow .windowname "Show this text" $list]
#
# Does a listbox thing with scroll bars where each entry is an element in
# the passed list.  Clicking cancel causes it to
# return empty, clicking OK or double clicking an entry returns the
# name of the corresponding array element.
#
# If more than one entry is selected, only the first one is returned.
#

proc list_listbox_subwindow {w label geometry list} {
    upvar #0 result_$w result
    catch {destroy $w}
    toplevel $w

    label $w.label -text $label
    pack $w.label -side top

    frame $w.frame
    pack $w.frame -side top

    scrollbar $w.frame.yscroll -relief sunken -command "$w.frame.list yview"
    pack $w.frame.yscroll -side right -fill y

    scrollbar $w.frame.xscroll -relief sunken -orient horizontal \
	    -command "$w.frame.list xview" 
    pack $w.frame.xscroll -side bottom -fill x
	    
    listbox $w.frame.list -yscroll "$w.frame.yscroll set" \
		-xscroll "$w.frame.xscroll set"  \
		-geometry $geometry -relief sunken
    pack $w.frame.list -side top

    bind $w.frame.list <Double-1> "list_subwindow_ok $w"

    foreach element $list {
        $w.frame.list insert end $element
    }

    frame $w.buttons
    button $w.buttons.ok -text OK -command "list_subwindow_ok $w"
    button $w.buttons.cancel -text Cancel -command "list_subwindow_cancel $w"
    pack $w.buttons.ok -side left -fill x
    pack $w.buttons.cancel -side left -fill x
    pack $w.buttons -side top

    tkwait window $w
    return $result
}

proc list_subwindow_cancel {w} {
    upvar #0 result_$w result
    set result ""
    destroy $w
}

proc list_subwindow_ok {w} {
    upvar #0 result_$w result
    set result [$w.frame.list get [lindex [$w.frame.list curselection] 0]]
    destroy $w
}
