mclistbox.tcl

# Copyright (c) 1999, Bryan Oakley
# All Rights Reservered
#
# Bryan Oakley
# oakley@channelpoint.com
#
# mclistbox v1.02 March 30, 1999
#
# a multicolumn listbox written in pure tcl
#
# this code is freely distributable without restriction, but is 
# provided as-is with no waranty expressed or implied. 
#
# basic usage: 
#    
#    mclistbox::mclistbox .listbox
#    .listbox column add col1 -label "Column 1"
#    .listbox column add col2 -label "Column 2"
#    .listbox insert end [list "some stuff" "some more stuff"]
#    .listbox insert end [list "a second row of stuff" "blah blah blah"]
#
# see the documentation for more, uh, documentation.
#
# Something to think about: implement a "-optimize" option, with two 
# values: speed and memory. If set to speed, keep a copy of the data
# in our hidden listbox so retrieval of data doesn't require us to
# do all the getting and splitting and so forth. If set to "memory",
# bag saving a duplicate copy of the data, which means data retrieval
# will be slower, but memory requirements will be reduced. 

package require Tk 8.3
package provide mclistbox 1.02

namespace eval ::mclistbox {
    variable bwidget 0
    if { ![catch {package require BWidget}] } {
	set bwidget 1
    }
    # this is the public interface
    namespace export mclistbox

    # these contain references to available options
    variable widgetOptions
    variable columnOptions

    # these contain references to available commands and subcommands
    variable widgetCommands
    variable columnCommands
    variable labelCommands
}

# ::mclistbox::Init --
#
#     Initialize the global (well, namespace) variables. This should
#     only be called once, immediately prior to creating the first
#     instance of the widget
#
# Results:
#
#     All state variables are set to their default values; all of 
#     the option database entries will exist.
#
# Returns:
# 
#     empty string

proc ::mclistbox::Init {} {
    variable widgetOptions
    variable columnOptions
    variable widgetCommands
    variable columnCommands
    variable labelCommands

    # here we match up command line options with option database names
    # and classes. As it turns out, this is a handy reference of all of the
    # available options. Note that if an item has a value with only one
    # item (like -bd, for example) it is a synonym and the value is the
    # actual item.

    array set widgetOptions [list \
	    -background          {background          Background} \
	    -bd                  -borderwidth \
	    -bg                  -background \
	    -borderwidth         {borderWidth         BorderWidth} \
	    -columnbd            -columnborderwidth \
	    -columnborderwidth   {columnBorderWidth   BorderWidth} \
	    -columnrelief        {columnRelief        Relief} \
	    -cursor              {cursor              Cursor} \
	    -exportselection     {exportSelection     ExportSelection} \
	    -fg                  -foreground \
	    -fillcolumn          {fillColumn          FillColumn} \
	    -font                {font                Font} \
	    -foreground          {foreground          Foreground} \
	    -height              {height              Height} \
	    -highlightbackground {highlightBackground HighlightBackground} \
	    -highlightcolor      {highlightColor      HighlightColor} \
	    -highlightthickness  {highlightThickness  HighlightThickness} \
	    -labelanchor         {labelAnchor         Anchor} \
	    -labelbackground     {labelBackground     Background} \
	    -labelbd             -labelborderwidth \
	    -labelbg             -labelbackground \
	    -labelborderwidth    {labelBorderWidth    BorderWidth} \
	    -labelfg             -labelforeground \
	    -labelfont           {labelFont           Font} \
	    -labelforeground     {labelForeground     Foreground} \
	    -labelheight         {labelHeight         Height} \
	    -labelimage          {labelImage          Image} \
	    -labelrelief         {labelRelief         Relief} \
	    -labels              {labels              Labels} \
	    -relief              {relief              Relief} \
	    -resizablecolumns    {resizableColumns    ResizableColumns} \
	    -selectbackground    {selectBackground    Foreground} \
	    -selectborderwidth   {selectBorderWidth   BorderWidth} \
	    -selectcommand       {selectCommand       Command} \
	    -selectforeground    {selectForeground    Background} \
	    -selectmode          {selectMode          SelectMode} \
	    -setgrid             {setGrid             SetGrid} \
            -state               {state               State} \
	    -takefocus           {takeFocus           TakeFocus} \
	    -width               {width               Width} \
	    -xscrollcommand      {xScrollCommand      ScrollCommand} \
	    -yscrollcommand      {yScrollCommand      ScrollCommand} \
	    -iseditableindexcommand \
	    {isEditableIndexCommand IsEditableIndexCommand} \
	    ]

    # If we have bwidget, add the bwidget drag-and-drop stuff.
    if { $::mclistbox::bwidget } {
	array set widgetOptions [list \
		-dragendcmd     {dragEndCmd           DragEndCmd}   \
		-dragenabled    {dragEnabled          DragEnabled}  \
		-draginitcmd    {dragInitCmd          DragInitCmd}  \
		-dragtype       {dragType             DragType}     \
		-dropcmd        {dropCmd              DropCmd}      \
		-dropenabled    {dropEnabled          DropEnabled}  \
		-dropovercmd    {dropOverCmd          DropOverCmd}  \
		-droptypes      {dropTypes            DropTypes}    \
		-dropcursor     {dropCursor           DropCursor}  \
		]

    }

    # and likewise for column-specific stuff. 
    array set columnOptions [list \
	    -background         {background           Background} \
	    -bitmap		{bitmap               Bitmap} \
	    -font               {font                 Font} \
	    -foreground         {foreground           Foreground} \
	    -image              {image                Image} \
	    -label 		{label                Label} \
	    -position           {position             Position} \
	    -resizable          {resizable            Resizable} \
	    -visible            {visible              Visible} \
	    -width              {width                Width} \
	    -editable           {editable             Editable} \
	    -editcommand        {editcommand          Editcommand} \
	    -listvar            {listvar              Listvar} \
            ]

    # this defines the valid widget commands. It's important to
    # list them here; we use this list to validate commands and
    # expand abbreviations.
    set widgetCommands [list \
	    activate	 bbox       cget     column    configure  \
	    curselection delete     edit     editcombo get       index      \
	    insert 	 label      nearest  scan      see        \
	    selection  	 size       xview    yview
    ]

    set columnCommands [list add cget configure delete names nearest x]
    set labelCommands  [list bind]

    ######################################################################
    #- this initializes the option database. Kinda gross, but it works
    #- (I think). 
    ######################################################################

    set packages [package names]

    # why check for the Tk package? This lets us be sourced into 
    # an interpreter that doesn't have Tk loaded, such as the slave
    # interpreter used by pkg_mkIndex. In theory it should have no
    # side effects when run 
    if {[lsearch -exact [package names] "Tk"] != -1} {

	# compute a widget name we can use to create a temporary widget
	set tmpWidget ".__tmp__"
	set count 0
	while {[winfo exists $tmpWidget] == 1} {
	    set tmpWidget ".__tmp__$count"
	    incr count
	}

	# steal options from the listbox
	# we want darn near all options, so we'll go ahead and do
	# them all. No harm done in adding the one or two that we
	# don't use.
	listbox $tmpWidget 
	foreach foo [$tmpWidget configure] {
	    if {[llength $foo] == 5} {
		set option [lindex $foo 1]
		set value [lindex $foo 4]
		option add *Mclistbox.$option $value widgetDefault

		# these options also apply to the individual columns...
		if {[string compare $option "foreground"] == 0 \
			|| [string compare $option "background"] == 0 \
			|| [string compare $option "font"] == 0} {
		    option add *Mclistbox*MclistboxColumn.$option $value \
			    widgetDefault
		}
	    }
	}
	destroy $tmpWidget

	# steal some options from label widgets; we only want a subset
	# so we'll use a slightly different method. No harm in *not*
	# adding in the one or two that we don't use... :-)
	label $tmpWidget
	foreach option [list Anchor Background Font \
		Foreground Height Image  ] {
	    set values [$tmpWidget configure -[string tolower $option]]
	    option add *Mclistbox.label$option [lindex $values 3]
	}
	destroy $tmpWidget

	# these are unique to us...
	option add *Mclistbox.columnBorderWidth   0      widgetDefault
	option add *Mclistbox.columnRelief        flat   widgetDefault
	option add *Mclistbox.labelBorderWidth    1      widgetDefault
	option add *Mclistbox.labelRelief         raised widgetDefault
	option add *Mclistbox.labels              1      widgetDefault
	option add *Mclistbox.resizableColumns    1      widgetDefault
	option add *Mclistbox.selectcommand       {}     widgetDefault
	option add *Mclistbox.fillcolumn          {}     widgetDefault
	option add *Mclistbox.iseditableindexcommand   {} widgetDefault
        option add *Mclistbox.state               normal widgetDefault

	# Bwidget stuff
	option add *Mclistbox.dragEndCmd          {}     widgetDefault
	option add *Mclistbox.dragEnabled         false  widgetDefault
	option add *Mclistbox.dragInitCmd         {}     widgetDefault
	option add *Mclistbox.dragType            {LISTBOX_ITEM} widgetDefault
	option add *Mclistbox.dropCmd             {}     widgetDefault
	option add *Mclistbox.dropEnabled         false  widgetDefault
	option add *Mclistbox.dropOverCmd         {}     widgetDefault
	option add *Mclistbox.dropTypes           \
		{LISTBOX_ITEM {copy {} move {}}} widgetDefault
	option add *Mclistbox.dropCursor          before   widgetDefault

	# column options
	option add *Mclistbox*MclistboxColumn.visible       1      widgetDefault
	option add *Mclistbox*MclistboxColumn.resizable     1      widgetDefault
	option add *Mclistbox*MclistboxColumn.position      end    widgetDefault
	option add *Mclistbox*MclistboxColumn.label         ""     widgetDefault
	option add *Mclistbox*MclistboxColumn.width         0      widgetDefault
	option add *Mclistbox*MclistboxColumn.bitmap        ""     widgetDefault
	option add *Mclistbox*MclistboxColumn.image         ""     widgetDefault
	option add *Mclistbox*MclistboxColumn.editable      \
		0   widgetDefault
	option add *Mclistbox*MclistboxColumn.editcommand      \
		""  widgetDefault
    }

    ######################################################################
    # define the class bindings
    ######################################################################
    
    SetClassBindings

}

# ::mclistbox::mclistbox --
#
#     This is the command that gets exported. It creates a new
#     mclistbox widget.
#
# Arguments:
#
#     w        path of new widget to create
#     args     additional option/value pairs (eg: -background white, etc.)
#
# Results:
#
#     It creates the widget and sets up all of the default bindings
#
# Returns:
#
#     The name of the newly create widget

proc ::mclistbox::mclistbox {args} {
    variable widgetOptions

    # perform a one time initialization
    if {![info exists widgetOptions]} {
	Init
    }

    # make sure we at least have a widget name
    if {[llength $args] == 0} {
	error "wrong # args: should be \"mclistbox pathName ?options?\""
    }

    # ... and make sure a widget doesn't already exist by that name
    if {[winfo exists [lindex $args 0]]} {
	error "window name \"[lindex $args 0]\" already exists"
    }

    # and check that all of the args are valid
    foreach {name value} [lrange $args 1 end] {
	Canonize [lindex $args 0] option $name
    }

    # build it...
    set w [eval Build $args]

    # set some bindings...
    SetBindings $w

    # and we are done!
    return $w
}

# ::mclistbox::Build --
#
#    This does all of the work necessary to create the basic
#    mclistbox. 
#
# Arguments:
#
#    w        widget name
#    args     additional option/value pairs
#
# Results:
#
#    Creates a new widget with the given name. Also creates a new
#    namespace patterened after the widget name, as a child namespace
#    to ::mclistbox
#
# Returns:
#
#    the name of the widget

proc ::mclistbox::Build {w args} {
    variable widgetOptions

    # create the namespace for this instance, and define a few
    # variables
    namespace eval ::mclistbox::$w {

	variable options
	variable widgets
	variable misc 
    }

    # this gives us access to the namespace variables within
    # this proc
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    # initially we start out with no columns
    set misc(columns) {}

    # this is our widget -- a frame of class Mclistbox. Naturally,
    # it will contain other widgets. We create it here because
    # we need it to be able to set our default options.
    set widgets(this)   [frame  $w -class Mclistbox -takefocus 1]

    # this defines all of the default options. We get the
    # values from the option database. Note that if an array
    # value is a list of length one it is an alias to another
    # option, so we just ignore it
    foreach name [array names widgetOptions] {
	if {[llength $widgetOptions($name)] == 1} continue
	set optName  [lindex $widgetOptions($name) 0]
	set optClass [lindex $widgetOptions($name) 1]
	set options($name) [option get $w $optName $optClass]
    }

    # now apply any of the options supplied on the command
    # line. This may overwrite our defaults, which is OK
    if {[llength $args] > 0} {
	array set options $args
    }
    
    # the columns all go into a text widget since it has the 
    # ability to scroll.
    set widgets(text) [text $w.text \
	    -width 0 \
	    -height 0 \
	    -padx 0 \
	    -pady 0 \
	    -wrap none \
	    -borderwidth 0 \
	    -highlightthickness 0 \
	    -takefocus 0 \
	    -cursor {} \
	    ]

    $widgets(text) configure -state disabled

    # here's the tricky part (shhhh... don't tell anybody!)
    # we are going to create column that completely fills 
    # the base frame. We will use it to control the sizing
    # of the widget. The trick is, we'll pack it in the frame 
    # and then place the text widget over it so it is never
    # seen.

    set columnWidgets [NewColumn $w {__hidden__} true]
    set widgets(hiddenFrame)   [lindex $columnWidgets 0]
    set widgets(hiddenListbox) [lindex $columnWidgets 1]
    set widgets(hiddenLabel)   [lindex $columnWidgets 2]

    # by default geometry propagation is turned off, but for this
    # super-secret widget we want it turned on. The idea is, we 
    # resize the listbox which resizes the frame which resizes the 
    # whole shibang.
    pack propagate $widgets(hiddenFrame) on

    pack $widgets(hiddenFrame) -side top -fill both -expand y
    place $widgets(text) -x 0 -y 0 -relwidth 1.0 -relheight 1.0
    raise $widgets(text)

    # we will later rename the frame's widget proc to be our
    # own custom widget proc. We need to keep track of this
    # new name, so we'll define and store it here...
    set widgets(frame) ::mclistbox::${w}::$w

    # this moves the original frame widget proc into our
    # namespace and gives it a handy name
    rename ::$w $widgets(frame)

    # now, create our widget proc. Obviously (?) it goes in
    # the global namespace. All mclistbox widgets will actually
    # share the same widget proc to cut down on the amount of
    # bloat. 
    proc ::$w {command args} \
	    "eval ::mclistbox::WidgetProc {$w} \$command \$args"

    # ok, the thing exists... let's do a bit more configuration. 
    if {[catch "Configure $widgets(this) [array get options]" res]} {
	catch {destroy $w}
	return -code error $res
    }

    # and be prepared to handle selections.. (this, for -exportselection
    # support)
    selection handle $w [list ::mclistbox::SelectionHandler $w get]

    return $w
}

# ::mclistbox::SelectionHandler --
#
#    handle reqests to set or retrieve the primary selection. This is
#    the "guts" of the implementation of the -exportselection option.
#    What a pain! Note that this command is *not* called as a result
#    of the widget's "selection" command, but rather as a result of
#    the global selection being set or cleared.
#
#    If I read the ICCCM correctly (which is doubtful; who has time to
#    read that thing thoroughly?), this should return each row as a tab
#    separated list of values, and the whole as a newline separated
#    list of rows.
#
# Arguments:
#
#    w       pathname of the widget
#    type    one of "own", "lose" or "get"
#    offset  only used if type is "get"; offset into the selection
#            buffer where the returned data should begin
#    length  number of bytes to return
#

proc ::mclistbox::SelectionHandler {w type {offset ""} {length ""}} {
    upvar ::mclistbox::${w}::options   options
    upvar ::mclistbox::${w}::misc      misc
    upvar ::mclistbox::${w}::widgets   widgets

    switch -exact $type {

	own {
	    selection own \
		    -command [list ::mclistbox::SelectionHandler $w lose] \
		    -selection PRIMARY \
		    $w
	}

	lose {
	    if {$options(-exportselection)} {
		foreach id $misc(columns) {
		    $widgets(listbox$id) selection clear 0 end
		}
	    }
	}

	get {
	    set end [expr {$length + $offset - 1}]

	    set column [lindex $misc(columns) 0]
	    set curselection [$widgets(listbox$column) curselection]

	    # this is really, really slow (relatively speaking).
	    # but the only way I can think of to speed this up
	    # is to duplicate all the data in our hidden listbox,
	    # which I really don't want to do because of memory
	    # considerations.
	    set data ""
	    foreach index $curselection {
		set rowdata [join [::mclistbox::WidgetProc-get $w $index]  "\t"]
		lappend data $rowdata
	    }
	    set data [join $data "\n"]
	    return [string range $data $offset $end]
	}

    }
}

# ::mclistbox::convert --
#
#     public routine to convert %x, %y and %W binding substitutions.
#     Given an x, y and or %W value relative to a given widget, this
#     routine will convert the values to be relative to the mclistbox
#     widget. For example, it could be used in a binding like this:
#
#     bind .mclistbox <blah> {doSomething [::mclistbox::convert %W -x %x]}
#
#     Note that this procedure is *not* exported, but is indented for
#     public use. It is not exported because the name could easily 
#     clash with existing commands. 
#
# Arguments:
#
#     w     a widget path; typically the actual result of a %W 
#           substitution in a binding. It should be either a
#           mclistbox widget or one of its subwidgets
#
#     args  should one or more of the following arguments or 
#           pairs of arguments:
#
#           -x <x>      will convert the value <x>; typically <x> will
#                       be the result of a %x substitution
#           -y <y>      will convert the value <y>; typically <y> will
#                       be the result of a %y substitution
#           -W (or -w)  will return the name of the mclistbox widget
#                       which is the parent of $w
#
# Returns:
#
#     a list of the requested values. For example, a single -w will
#     result in a list of one items, the name of the mclistbox widget.
#     Supplying "-x 10 -y 20 -W" (in any order) will return a list of
#     three values: the converted x and y values, and the name of 
#     the mclistbox widget.

proc ::mclistbox::convert {w args} {
    set result {}
    if {![winfo exists $w]} {
	error "window \"$w\" doesn't exist"
    }

    while {[llength $args] > 0} {
	set option [lindex $args 0]
	set args [lrange $args 1 end]

	switch -exact -- $option {
	    -x {
		set value [lindex $args 0]
		set args [lrange $args 1 end]
		set win $w
		while {[winfo class $win] != "Mclistbox"} {
		    incr value [winfo x $win]
		    set win [winfo parent $win]
		    if {$win == "."} break
		}
		lappend result $value
	    }

	    -y {
		set value [lindex $args 0]
		set args [lrange $args 1 end]
		set win $w
		while {[winfo class $win] != "Mclistbox"} {
		    incr value [winfo y $win]
		    set win [winfo parent $win]
		    if {$win == "."} break
		}
		lappend result $value
	    }

	    -w -
	    -W {
		set win $w
		while {[winfo class $win] != "Mclistbox"} {
		    set win [winfo parent $win]
		    if {$win == "."} break;
		}
		lappend result $win
	    }
	}
    }
    return $result
}

# ::mclistbox::SetBindings --
#
#    Sets up the default bindings for the named widget
#
# Arguments:
#
#    w   the widget pathname for which the bindings should be assigned
#
# Results:
#
#    The named widget will inheirit all of the default Mclistbox
#    bindings.

proc ::mclistbox::SetBindings {w} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    # we must do this so that the columns fill the text widget in
    # the y direction
    bind $widgets(text) <Configure> \
	    [list ::mclistbox::AdjustColumns $w %h]

}

# ::mclistbox::SetClassBindings --
#
#    Sets up the default bindings for the widget class
#
# Arguments:
#
#    none
#

proc ::mclistbox::SetClassBindings {} {
    # this allows us to clean up some things when we go away
    bind Mclistbox <Destroy> [list ::mclistbox::DestroyHandler %W]

    # steal all of the standard listbox bindings. Note that if a user
    # clicks in a column, %W will return that column. This is bad,
    # so we have to make a substitution in all of the bindings to
    # compute the real widget name (ie: the name of the topmost 
    # frame)
    foreach event [bind Listbox] {
	set binding [bind Listbox $event]
	regsub -all {%W} $binding {[::mclistbox::convert %W -W]} binding
	regsub -all {%x} $binding {[::mclistbox::convert %W -x %x]} binding
	regsub -all {%y} $binding {[::mclistbox::convert %W -y %y]} binding
	bind Mclistbox $event $binding
    }

    # Add a button press binding to track selection for drag and drop
    bind Mclistbox <ButtonPress-1> [list +::mclistbox::SetDragIndex %W %Y]

    # these define bindings for the column labels for resizing. Note
    # that we need both the name of this widget (calculated by $this)
    # as well as the specific widget that the event occured over.
    # Also note that $this is a constant string that gets evaluated
    # when the binding fires.
    # What a pain.
    set this {[::mclistbox::convert %W -W]}
    bind MclistboxMouseBindings <ButtonPress-1> \
	    "::mclistbox::ResizeEvent $this buttonpress %W %x %X %Y"
    bind MclistboxMouseBindings <ButtonRelease-1> \
	    "::mclistbox::ResizeEvent $this buttonrelease %W %x %X %Y"
    bind MclistboxMouseBindings <Enter> \
	    "::mclistbox::ResizeEvent $this motion %W %x %X %Y"
    bind MclistboxMouseBindings <Motion> \
	    "::mclistbox::ResizeEvent $this motion %W %x %X %Y"
    bind MclistboxMouseBindings <B1-Motion> \
	    "::mclistbox::ResizeEvent $this drag %W %x %X %Y"
}

# ::mclistbox::SetDragIndex --
#
#    Store the drag index when the button is first clicked so that the right
#    item is dragged and dropped.
#
# Arguments:
#
#    path          The path to the widget where the drag is started (%W from
#                  bind).
#    Y             The %Y from bind.
#
# Results:
#
#    Calculates the index of the row that was clicked in case it the item is
#    dragged.
#

proc ::mclistbox::SetDragIndex {path Y} {
    set index [$path nearest [expr {$Y - [winfo rooty $path]}]]
    set path  [::mclistbox::convert $path -W]
    upvar ::mclistbox::${path}::options options

    set options(dragIndex) $index
    
    return
}

# ::mclistbox::NewColumn --
#
#    Adds a new column to the mclistbox widget
#
# Arguments:
#
#    w       the widget pathname
#    id      the id for the new column
#    hidden  boolean indicating if this is a hidden column (HACK! YUCK!)
#
# Results:
#
#    Creates a set of widgets which defines the column. Adds 
#    appropriate entries to the global array widgets for the
#    new column. 
#
#    Note that this column is not added to the listbox by 
#    this proc.
#
# Returns:
#
#    A list of four elements: the path to the column frame, 
#    the path to the column listbox, the path to the column
#    label, and the path to the editbutton, in that order.

proc ::mclistbox::NewColumn {w id {hidden false}} {
    upvar ::mclistbox::${w}::widgets   widgets
    upvar ::mclistbox::${w}::options   options
    upvar ::mclistbox::${w}::misc      misc
    upvar ::mclistbox::${w}::columnID  columnID

    # the columns are all children of the text widget we created... 
    if { $hidden } {
	set parent $w
    } else {
	set parent $w.text
    }
    set frame     \
	    [frame $parent.frame$id \
	    -takefocus 0 \
	    -highlightthickness 0 \
	    -class MclistboxColumn \
	    -background $options(-background) \
	    ]

    set label     \
	    [label $frame.label \
	    -takefocus 0 \
	    -relief raised \
	    -bd 1 \
	    -highlightthickness 0 \
            -state $options(-state) \
	    ]

    set listbox   \
	    [listbox $frame.listbox \
	    -takefocus 0 \
	    -bd 0 \
	    -setgrid $options(-setgrid) \
	    -exportselection false \
	    -selectmode $options(-selectmode) \
	    -highlightthickness 0 \
	    -yscrollcommand [list ::mclistbox::InvalidateScrollbars $w] \
	    ]

    set button \
	    [button $frame.editbutton \
	    -bd 1        \
            -padx 0      \
            -pady 0      \
	    -text "Edit" \
	    -command [list ::mclistbox::_editButtonCommand $w $id] \
	    -state disabled
	    ]
    # Pick up the font family from the default, but change the size to 8 point
    # (so it's very small) and drop any bold/italic/whatever modifiers
    foreach {fontFamily fontSize} [$button cget -font] break
    set fontSize 8
    $button configure -font [list $fontFamily $fontSize]

    # define mappings from widgets to columns
    set columnID($label) $id
    set columnID($frame) $id
    set columnID($listbox) $id
    set columnID($button) $id

    # we're going to associate a new bindtag for the label to
    # handle our resize bindings. Why? We want the bindings to
    # be specific to this widget but we don't want to use the
    # widget name. If we use the widget name then the bindings
    # could get mixed up with user-supplied bindigs (via the 
    # "label bind" command). 
    set tag MclistboxLabel
    bindtags $label  [list MclistboxMouseBindings $label]

    # reconfigure the label based on global options
    foreach option [list bd image height relief font anchor \
	    background foreground borderwidth] {
	if {[info exists options(-label$option)] \
		&& $options(-label$option) != ""} {
	    $label configure -$option $options(-label$option)
	}
    }

    # reconfigure the column based on global options
    foreach option [list borderwidth relief] {
	if {[info exists options(-column$option)] \
		&& $options(-column$option) != ""} {
	    $frame configure -$option $options(-column$option)
	}
    }

    # geometry propagation must be off so we can control the size
    # of the listbox by setting the size of the containing frame
    pack propagate $frame off

    pack $label   -side top -fill x -expand n
    pack $listbox -side top -fill both -expand y -pady 2

    # any events that happen in the listbox gets handled by the class
    # bindings. This has the unfortunate side effect 
    bindtags $listbox [list $w Mclistbox all]
    # Make the listbox a bwidget drag and drop site, if we have bwidgets
    if { $::mclistbox::bwidget } {
	if { $options(-dragenabled) } {
	    DragSite::register $listbox                      \
		    -draginitcmd ::mclistbox::_init_drag_cmd \
		    -dragendcmd  ::mclistbox::_drag_end_cmd  \
		    -dragevent 1
	}
	if { $options(-dropenabled) } {
	    DropSite::register $listbox                 \
		    -droptypes   $options(-droptypes)   \
		    -dropovercmd ::mclistbox::_over_cmd \
		    -dropcmd     ::mclistbox::_drop_cmd
	}
    }


    # return a list of the widgets we created.
    return [list $frame $listbox $label $button]
}

# ::mclistbox::Column-add --
#
#    Implements the "column add" widget command
#
# Arguments:
#
#    w      the widget pathname
#    args   additional option/value pairs which define the column
#
# Results:
#
#    A column gets created and added to the listbox

proc ::mclistbox::Column-add {w args} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    variable widgetOptions

    set id "column-[llength $misc(columns)]" ;# a suitable default

    # if the first argument doesn't have a "-" as the first
    # character, it is an id to associate with this column
    if {![string match {-*} [lindex $args 0]]} {
	# the first arg must be an id. 
	set id [lindex $args 0]
	set args [lrange $args 1 end]
	if {[lsearch -exact $misc(columns) $id] != -1} {
	    error "column \"$id\" already exists"
	}
    }

    # define some reasonable defaults, then add any specific
    # values supplied by the user
    set opts(-bitmap)      {}
    set opts(-image)       {}
    set opts(-visible)     1
    set opts(-resizable)   1
    set opts(-position)    "end"
    set opts(-width)       20
    set opts(-background)  $options(-background)
    set opts(-foreground)  $options(-foreground)
    set opts(-font)        $options(-font)
    set opts(-label)       $id
    set opts(-editable)    0
    set opts(-editcommand) ""
    set opts(-listvar)     ""

    if {[expr {[llength $args]%2}] == 1} {
	# hmmm. An odd number of elements in args
	# if the last item is a valid option we'll give a different
	# error than if its not
	set option [::mclistbox::Canonize $w "column option" [lindex $args end]]
	error "value for \"[lindex $args end]\" missing"
    }
    array set opts $args

    # figure out if we have any data in the listbox yet; we'll need
    # this information in a minute...
    if {[llength $misc(columns)] > 0} {
	set col0 [lindex $misc(columns) 0]
	set existingRows [$widgets(listbox$col0) size]
    } else {
	set existingRows 0
    }

    # create the widget and assign the associated paths to our array
    set widgetlist [NewColumn $w $id]

    set widgets(frame$id)   [lindex $widgetlist 0]
    set widgets(listbox$id) [lindex $widgetlist 1]
    set widgets(label$id)   [lindex $widgetlist 2]
    # ericm@scriptics
    set widgets(editbutton$id)  [lindex $widgetlist 3]
    # ericm@scriptics

    if {[string equal $options(-state) "disabled"]} {
        set opts(-foreground) [$widgets(label$id) cget -disabledforeground]
    }

    # add this column to the list of known columns
    lappend misc(columns) $id

    # configure the options. As a side effect, it will be inserted
    # in the text widget
    eval ::mclistbox::Column-configure {$w} {$id} [array get opts]

    # now, if there is any data already in the listbox, we need to
    # add a corresponding number of blank items. At least, I *think*
    # that's the right thing to do.
    if {$existingRows > 0} {
	set blanks {}
	# The new listbox may already have data in it (because of the listvar)
        # so start iterating from [listbox size] instead of from 0
	for {set i [$widgets(listbox$id) size]} {$i < $existingRows} {incr i} {
	    lappend blanks {}
	}
	eval {$widgets(listbox$id)} insert end $blanks
    }

    InvalidateScrollbars $w
    return $id
}

# ::mclistbox::Column-configure --
#
#    Implements the "column configure" widget command
#
# Arguments:
#
#    w     widget pathname
#    id    column identifier
#    args  list of option/value pairs

proc ::mclistbox::Column-configure {w id args} {
    variable widgetOptions
    variable columnOptions

    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    # bail if they gave us a bogus id
    set index [CheckColumnID $w $id]

    # define some shorthand
    set listbox $widgets(listbox$id)
    set frame   $widgets(frame$id)
    set label   $widgets(label$id)
    set editbutton $widgets(editbutton$id)

    if {[llength $args] == 0} {
	# hmmm. User must be wanting all configuration information
	# note that if the value of an array element is of length
	# one it is an alias, which needs to be handled slightly
	# differently
	set results {}
	foreach opt [lsort [array names columnOptions]] {
	    if {[llength $columnOptions($opt)] == 1} {
		set alias $columnOptions($opt)
		set optName $columnOptions($alias)
		lappend results [list $opt $optName]
	    } else {
		set optName  [lindex $columnOptions($opt) 0]
		set optClass [lindex $columnOptions($opt) 1]
		set default [option get $frame $optName $optClass]
		lappend results [list $opt $optName $optClass \
			$default $options($id:$opt)]
	    }
	}

	return $results


    } elseif {[llength $args] == 1} {

	# the user must be querying something... I need to get this
	# to return a bona fide list like the "real" configure 
	# command, but it's not a priority at the moment. I still
	# have to work on the option database support foo.
	set option [::mclistbox::Canonize $w "column option" [lindex $args 0]]

	set value $options($id:$option)
	set optName  [lindex $columnOptions($option) 0]
	set optClass [lindex $columnOptions($option) 1]
	set default  [option get $frame $optName $optClass]
	set results  [list $option $optName $optClass $default $value]
	return $results

    }

    # if we have an odd number of values, bail. 
    if {[expr {[llength $args]%2}] == 1} {
	# hmmm. An odd number of elements in args
	error "value for \"[lindex $args end]\" missing"
    }
    
    # Great. An even number of options. Let's make sure they 
    # are all valid before we do anything. Note that Canonize
    # will generate an error if it finds a bogus option; otherwise
    # it returns the canonical option name
    foreach {name value} $args {
	set name [::mclistbox::Canonize $w "column option" $name]
	set opts($name) $value
    }

    # if we get to here, the user is wanting to set some options
    foreach option [array names opts] {
	set value $opts($option)
	set options($id:$option) $value

	switch -- $option {
	    -label {
		$label configure -text $value
	    }
	    
	    -image -
	    -bitmap {
		$label configure $option $value
	    }

	    -width {
		set font [$listbox cget -font]
		set factor [font measure $options(-font) "0"]
		set width [expr {$value * $factor}]

		$widgets(frame$id) configure -width $width
		set misc(min-$widgets(frame$id)) $width
		AdjustColumns $w
	    }
	    -font -
	    -foreground -
	    -background {
		if {[string length $value] == 0} {set value $options($option)}
		$listbox configure $option $value
	    }

	    -resizable {
		if {[catch {
		    if {$value} {
			set options($id:-resizable) 1
		    } else {
			set options($id:-resizable) 0
		    }
		} msg]} {
		    error "expected boolean but got \"$value\""
		}
	    }

	    -visible {
		if {[catch {
		    if {$value} {
			set options($id:-visible) 1
			$widgets(text) configure -state normal
			$widgets(text) window configure 1.$index -window $frame
			$widgets(text) configure -state disabled

		    } else {
			set options($id:-visible) 0
			$widgets(text) configure -state normal
			$widgets(text) window configure 1.$index -window {}
			$widgets(text) configure -state disabled
		    }
		    InvalidateScrollbars $w
		} msg]} {
		    error "expected boolean but got \"$value\""
		}

	    }

	    -position {
		if {[string compare $value "start"] == 0} {
		    set position 0

		} elseif {[string compare $value "end"] == 0} {

		    set position [expr {[llength $misc(columns)] -1}]
		} else {

		    # ought to check for a legal value here, but I'm 
		    # lazy
		    set position $value
		}

		if {$position >= [llength $misc(columns)]} {
		    set max [expr {[llength $misc(columns)] -1}]
		    error "bad position; must be in the range of 0-$max"
		}

		# rearrange misc(columns) to reflect the new ordering
		set current [lsearch -exact $misc(columns) $id]
		set misc(columns) [lreplace $misc(columns) $current $current]
		set misc(columns) [linsert $misc(columns) $position $id]
		
		set frame $widgets(frame$id)
		$widgets(text) configure -state normal
		$widgets(text) window create 1.$position \
			-window $frame -stretch 1
		$widgets(text) configure -state disabled
 	    }

	    -editable {
		# Toggle the editable flag for the column; add or
		# remove the editable button as needed
		if { ![string is boolean $value] } {
		    error "expected boolean value but got \"$value\""
		}
		if { $value } {
		    # Add the button
			set fnt [$editbutton cget -font]
			set txt [$editbutton cget -text]
			set width   [expr {[font measure $fnt $txt]*1.5}]
		    place $editbutton		\
			    -in		$label	\
			    -anchor	ne	\
			    -relx	1.0	\
			    -x		-2	\
			    -rely	0.0	\
			    -width	$width	\
			    -relheight 1.0	
		} else {
		    # Remove the button
		    place forget $editbutton
		}
	    }

	    -editcommand {
		# Set the editcommand for the column
		set options($id:-editcommand) $value
	    }

            -listvar {
                # Set the list variable for the column
                $listbox configure $option $value
	    }
	}
    }
}


# ::mclistbox::DestroyHandler {w} --
# 
#    Cleans up after a mclistbox widget is destroyed
#
# Arguments:
#
#    w    widget pathname
#
# Results:
#
#    The namespace that was created for the widget is deleted,
#    and the widget proc is removed.

proc ::mclistbox::DestroyHandler {w} {

    # kill off any idle event we might have pending
    if {[info exists ::mclistbox::${w}::misc(afterid)]} {
	catch {
	    after cancel $::mclistbox::${w}::misc(afterid)
	    unset ::mclistbox::${w}::misc(afterid)
	}
    }

    # if the widget actually being destroyed is of class Mclistbox,
    # crush the namespace and kill the proc. Get it? Crush. Kill. 
    # Destroy. Heh. Danger Will Robinson! Oh, man! I'm so funny it
    # brings tears to my eyes.
    if {[string compare [winfo class $w] "Mclistbox"] == 0} {
	namespace delete ::mclistbox::$w
	rename $w {}
    }

}

# ::mclistbox::FirstVisibleColumn --
#
#    this proc returns the id of the first visible column.
#
# Arguments:
#
#    w       widget pathname
#
# Results:
#
#    a string

proc ::mclistbox::FirstVisibleColumn {w} {
    upvar ::mclistbox::${w}::misc      misc
    upvar ::mclistbox::${w}::options      options

    foreach id $misc(columns) {
	if {$options($id:-visible)} {break}
    }

    return $id
}

# ::mclistbox::MassageIndex --
#
#    this proc massages indicies of the form @x,y such that 
#    the coordinates are relative to the first listbox rather 
#    than relative to the topmost frame. 
#
# Arguments:
#
#    w       widget pathname
#    index   an index of the form @x,y
#
# Results:
#
#    Returns a new index with translated coordinates. This index
#    may be used directly by an internal listbox.

proc ::mclistbox::MassageIndex {w index} {
    upvar ::mclistbox::${w}::widgets   widgets
    upvar ::mclistbox::${w}::misc      misc

    if {[regexp {@([0-9]+),([0-9]+)} $index matchvar x y]} {
	set id [FirstVisibleColumn $w]
	
	incr y -[winfo y $widgets(listbox$id)]
	incr y -[winfo y $widgets(frame$id)]
	incr x [winfo x $widgets(listbox$id)]
	incr x [winfo x $widgets(frame$id)]

	set index @${x},${y}
    }

    return $index
}

# ::mclistbox::WidgetProc --
#
#    This gets uses as the widgetproc for an mclistbox widget. 
#    Notice where the widget is created and you'll see that the
#    actual widget proc merely evals this proc with all of the
#    arguments intact.
#
#    Note that some widget commands are defined "inline" (ie:
#    within this proc), and some do most of their work in 
#    separate procs. This is merely because sometimes it was
#    easier to do it one way or the other.
#
# Arguments:
#
#    w         widget pathname
#    command   widget subcommand
#    args      additional arguments; varies with the subcommand
#
# Results:
#
#    Performs the requested widget command

proc ::mclistbox::WidgetProc {w command args} {
    variable widgetOptions

    upvar ::mclistbox::${w}::widgets   widgets
    upvar ::mclistbox::${w}::options   options
    upvar ::mclistbox::${w}::misc      misc
    upvar ::mclistbox::${w}::columnID  columnID

    set command [::mclistbox::Canonize $w command $command]

    # some commands have subcommands. We'll check for that here 
    # and mung the command and args so that we can treat them as 
    # distinct commands in the following switch statement
    if {[string compare $command "column"] == 0} {
	set subcommand [::mclistbox::Canonize $w "column command" \
		[lindex $args 0]]
	set command "$command-$subcommand"
	set args [lrange $args 1 end]

    } elseif {[string compare $command "label"] == 0} {
	set subcommand [::mclistbox::Canonize $w "label command" \
		[lindex $args 0]]
	set command "$command-$subcommand"
	set args [lrange $args 1 end]
    }

    set result ""
    if {[info exists priorSelection]} {
        unset priorSelection
    }

    # here we go. Error checking be damned!
    switch $command {
	xview {
	    # note that at present, "xview <index>" is broken. I'm
	    # not even sure how to do it. Unless I attach our hidden
	    # listbox to the scrollbar and use it. Hmmm..... I'll
	    # try that later. (FIXME)
	    set result [eval {$widgets(text)} xview $args]
	    InvalidateScrollbars $w
	}

	yview {
	    if {[llength $args] == 0} {
		# length of zero means to fetch the yview; we can
		# get this from a single visible listbox; default result is
		# {0 1}, so at least we don't throw an error if there are no
		# visible columns
		set result [list 0 1]
		foreach id $misc(columns) {
		    if { $options($id:-visible) } {
			set result [$widgets(listbox$id) yview]
			break
		    }
		}

	    } else {

		# if it's one argument, it's an index. We'll pass that 
		# index through the index command to properly translate
		# @x,y indicies, and place the value back in args
		if {[llength $args] == 1} {
		    set index [::mclistbox::MassageIndex $w [lindex $args 0]]
		    set args [list $index]
		}

		# run the yview command on every column.
		foreach id $misc(columns) {
		    eval {$widgets(listbox$id)} yview $args
		}
		eval {$widgets(hiddenListbox)} yview $args

		InvalidateScrollbars $w

		set result ""
	    }
	}

	activate {
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w activate index"
	    }
	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    foreach id $misc(columns) {
		$widgets(listbox$id) activate $index
	    }
	    set result ""
	}

	bbox {
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w bbox index"
	    }
	    # get a real index. This will adjust @x,y indicies
	    # to account for the label, if any.
	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    set id [FirstVisibleColumn $w]

	    # we can get the x, y, and height from the first 
	    # column.
	    set bbox [$widgets(listbox$id) bbox $index]
	    if {[string length $bbox] == 0} {return ""}

	    foreach {x y width h} $bbox {}
	    
	    # the x and y coordinates have to be adjusted for the
	    # fact that the listbox is inside a frame, and the 
	    # frame is inside a text widget. All of those add tiny
	    # offsets. Feh.
	    incr y [winfo y $widgets(listbox$id)]
	    incr y [winfo y $widgets(frame$id)]
	    incr x [winfo x $widgets(listbox$id)]
	    incr x [winfo x $widgets(frame$id)]

	    # we can get the width by looking at the relative x 
	    # coordinate of the right edge of the last visible column
	    set index [expr [llength $misc(columns)] - 1]
	    set id [lindex $misc(columns) $index]
	    while { $index && ![expr {$options($id:-visible)}] } {
		incr index -1
		set id [lindex $misc(columns) $index]
	    }
	    set width [expr {[winfo width $widgets(frame$id)] + \
		    [winfo x $widgets(frame$id)]}]
	    set bbox [list $x $y [expr {$x + $width}] $h]
	    set result $bbox
	}

	label-bind {
	    # we are just too clever for our own good. (that's a 
	    # polite way of saying this is more complex than it
	    # needs to be)

	    set id [lindex $args 0]
	    set index [CheckColumnID $w $id]

	    set args [lrange $args 1 end]
	    if {[llength $args] == 0} {
		set result [bind $widgets(label$id)]
	    } else {

		# when we create a binding, we'll actually have the 
		# binding run our own command with the user's command
		# as an argument. This way we can do some sanity checks
		# before running the command. So, when querying a binding
		# we need to only return the user's code
		set sequence [lindex $args 0]
		if {[llength $args] == 1} {
		    set result [lindex [bind $widgets(label$id) $sequence] end]
		} else {
		
		    # replace %W with our toplevel frame, then
		    # do the binding
		    set code [lindex $args 1]
		    regsub -all {%W} $code $w code
		    
		    set result [bind $widgets(label$id) $sequence \
			    [list ::mclistbox::LabelEvent $w $id $code]]
		}
	    }
	}

	column-add {
	    eval ::mclistbox::Column-add {$w} $args
	    AdjustColumns $w
	    set result ""
	}

	column-delete {
	    foreach id $args {
		set index [CheckColumnID $w $id]

		# remove the reference from our list of columns
		set misc(columns) [lreplace $misc(columns) $index $index]

		# whack the widget
		destroy $widgets(frame$id)

		# clear out references to the individual widgets
		unset widgets(frame$id)
		unset widgets(listbox$id)
		unset widgets(label$id)
		unset widgets(editbutton$id)
	    }
	    InvalidateScrollbars $w
	    set result ""
	}

	column-cget {
	    if {[llength $args] != 2} {
		error "wrong # of args: should be \"$w column cget name option\""
	    }
	    set id [::mclistbox::Canonize $w column [lindex $args 0]]
	    set option [lindex $args 1]
	    set data [::mclistbox::Column-configure $w $id $option]
	    set result [lindex $data 4]
	}

	column-configure {
	    set id [::mclistbox::Canonize $w column [lindex $args 0]]
	    set args [lrange $args 1 end]
	    set result [eval ::mclistbox::Column-configure {$w} {$id} $args]
	}

	column-names {
	    if {[llength $args] != 0} {
		error "wrong # of args: should be \"$w column names\""
	    }
	    set result $misc(columns)
	}

	column-nearest {
	    if {[llength $args] != 1} {
		error "wrong # of args: should be \"$w column nearest x\""
	    }

	    set x [lindex $args 0]
	    set tmp [$widgets(text) index @$x,0]
	    set tmp [split $tmp "."]
	    set index [lindex $tmp 1]

	    set result [lindex $misc(columns) $index]
	}

	column-x {
	    if {[llength $args] != 1} {
		error "wrong # of args: should be \"$w column x name\""
	    }
	    set id     [lindex $args 0]
	    set result [winfo x $widgets(frame$id)]
	}

	cget {
	    if {[llength $args] != 1} {
		error "wrong # args: should be $w cget option"
	    }
	    set opt [::mclistbox::Canonize $w option [lindex $args 0]]

	    set result $options($opt)
	}


	configure {
	    set result [eval ::mclistbox::Configure {$w} $args]

	}

	curselection {
	    set id [lindex $misc(columns) 0]
	    set result [$widgets(listbox$id) curselection]
	}

	delete {
	    if {[llength $args] < 1 || [llength $args] > 2} {
		error "wrong \# of args: should be $w delete first ?last?"
	    }

	    # it's possible that the selection will change because
	    # of something we do. So, grab the current selection before
	    # we do anything. Just before returning we'll see if the
	    # selection has changed. If so, we'll call our selectcommand
	    if {$options(-selectcommand) != ""} {
		set col0 [lindex $misc(columns) 0]
		set priorSelection [$widgets(listbox$col0) curselection]
	    }

	    set index1 [::mclistbox::MassageIndex $w [lindex $args 0]]
	    if {[llength $args] == 2} {
		set index2 [::mclistbox::MassageIndex $w [lindex $args 1]]
	    } else {
		set index2 ""
	    }

	    # note we do an eval here to make index2 "disappear" if it
	    # is set to an empty string.
	    foreach id $misc(columns) {
		eval {$widgets(listbox$id)} delete $index1 $index2
	    }
	    eval {$widgets(hiddenListbox)} delete $index1 $index2

	    InvalidateScrollbars $w

	    set result ""
	}

	edit {
	    if { [llength $args] != 3 && [llength $args] != 4 } {
		error "wrong \# of args: should be $w edit column index var"
	    }
	    set result [eval ::mclistbox::edit $w $args]
	}

	editcombo {
	    if { [llength $args] != 4 } {
		error "wrong \# of args: should be $w editcombo\
			column index var values"
	    }
	    set result [eval ::mclistbox::editcombo $w $args]
	}

	get {
	    if {[llength $args] < 1 || [llength $args] > 2} {
		error "wrong \# of args: should be $w get first ?last?"
	    }
	    set index1 [::mclistbox::MassageIndex $w [lindex $args 0]]
	    if {[llength $args] == 2} {
		set index2 [::mclistbox::MassageIndex $w [lindex $args 1]]
	    } else {
		set index2 ""
	    }

	    set result [eval ::mclistbox::WidgetProc-get {$w} $index1 $index2]

	}

	index {

	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w index index"
	    }

	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    # Select a visible column to convert the screen location
	    # into row ... Invisible columns are not mapped and can't
	    # do this. They always returns row 0.

	    set id     [FirstVisibleColumn $w]
	    set result [$widgets(listbox$id) index $index]
	}

	insert {
	    if {[llength $args] < 1} {
		error "wrong \# of args: should be $w insert ?element \
		      element...?"
	    }

	    # it's possible that the selection will change because
	    # of something we do. So, grab the current selection before
	    # we do anything. Just before returning we'll see if the
	    # selection has changed. If so, we'll call our selectcommand
	    if {$options(-selectcommand) != ""} {
		set col0 [lindex $misc(columns) 0]
		set priorSelection [$widgets(listbox$col0) curselection]
	    }

	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    ::mclistbox::Insert $w $index [lrange $args 1 end]

	    InvalidateScrollbars $w
	    set result ""
	}

	nearest {
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w nearest y"
	    }

	    # translate the y coordinate into listbox space
	    set id [lindex $misc(columns) 0]
	    set y [lindex $args 0]
	    incr y -[winfo y $widgets(listbox$id)]
	    incr y -[winfo y $widgets(frame$id)]

	    set col0 [lindex $misc(columns) 0]

	    set result [$widgets(listbox$col0) nearest $y]
	}

	scan {
	    foreach {subcommand x y} $args {}
	    switch $subcommand {
		mark {
		    # we have to treat scrolling in x and y differently;
		    # scrolling in the y direction affects listboxes and
		    # scrolling in the x direction affects the text widget.
		    # to facilitate that, we need to keep a local copy
		    # of the scan mark.
		    set misc(scanmarkx) $x
		    set misc(scanmarky) $y
		    
		    # set the scan mark for each column
		    foreach id $misc(columns) {
			$widgets(listbox$id) scan mark $x $y
		    }

		    # we can't use the x coordinate given us, since it 
		    # is relative to whatever column we are over. So,
		    # we'll just usr the results of [winfo pointerx].
		    $widgets(text) scan mark [winfo pointerx $w]  $y
		}
		dragto {
		    # we want the columns to only scan in the y direction,
		    # so we'll force the x componant to remain constant
		    foreach id $misc(columns) {
			$widgets(listbox$id) scan dragto $misc(scanmarkx) $y
		    }

		    # since the scan mark of the text widget was based
		    # on the pointer location, so must be the x
		    # coordinate to the dragto command. And since we
		    # want the text widget to only scan in the x
		    # direction, the y componant will remain constant
		    $widgets(text) scan dragto \
			    [winfo pointerx $w] $misc(scanmarky)

		    # make sure the scrollbars reflect the changes.
		    InvalidateScrollbars $w
		}
	    }
	    set result ""
	}

	see {
	    if {[llength $args] != 1} {
		error "wrong \# of args: should be $w see index"
	    }
	    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

	    foreach id $misc(columns) {
		$widgets(listbox$id) see $index
	    }
	    InvalidateScrollbars $w
	    set result {}
	}

	selection {
	    # it's possible that the selection will change because
	    # of something we do. So, grab the current selection before
	    # we do anything. Just before returning we'll see if the
	    # selection has changed. If so, we'll call our selectcommand

           if {[string equal $options(-state) "disabled"]} {
	       foreach id $misc(columns) {
                   $widgets(listbox$id) selection clear 0 end
	       }
           }

	    if {$options(-selectcommand) != ""} {
		set col0 [lindex $misc(columns) 0]
		set priorSelection [$widgets(listbox$col0) curselection]
	    }

	    set subcommand [lindex $args 0]
	    set args [lrange $args 1 end]

	    set prefix "wrong \# of args: should be $w"
	    switch $subcommand {
		includes {
		    if {[llength $args] != 1} {
			error "$prefix selection $subcommand index"
		    }
		    set index [::mclistbox::MassageIndex $w [lindex $args 0]]
		    set id [FirstVisibleColumn $w]
		    set result [$widgets(listbox$id) selection includes $index]
		}

		set {
		    switch [llength $args] {
			1 {
			    set index1 [::mclistbox::MassageIndex $w \
				    [lindex $args 0]]
			    set index2 ""
			}
			2 {
			    set index1 [::mclistbox::MassageIndex $w \
				    [lindex $args 0]]
			    set index2 [::mclistbox::MassageIndex $w \
				    [lindex $args 1]]
			}
			default {
			    error "$prefix selection clear first ?last?"
			}
		    }

		    if {$options(-exportselection)} {
			SelectionHandler $w own
		    }
		    if {$index1 != ""} {
			foreach id $misc(columns) {
			    eval {$widgets(listbox$id)} selection set \
				    $index1 $index2
			}
		    }

		    set result ""
		}

		anchor {
		    if {[llength $args] != 1} {
			error "$prefix selection $subcommand index"
		    }
		    set index [::mclistbox::MassageIndex $w [lindex $args 0]]

		    if {$options(-exportselection)} {
			SelectionHandler $w own
		    }
		    foreach id $misc(columns) {
			$widgets(listbox$id) selection anchor $index
		    }
		    set result ""
		}

		clear {
		    switch [llength $args] {
			1 {
			    set index1 [::mclistbox::MassageIndex $w \
				    [lindex $args 0]]
			    set index2 ""
			}
			2 {
			    set index1 [::mclistbox::MassageIndex $w \
				    [lindex $args 0]]
			    set index2 [::mclistbox::MassageIndex $w \
				    [lindex $args 1]]
			}
			default {
			    error "$prefix selection clear first ?last?"
			}
		    }

		    if {$options(-exportselection)} {
			SelectionHandler $w own
		    }
		    foreach id $misc(columns) {
			eval {$widgets(listbox$id)} selection clear \
				$index1 $index2
		    }
		    set result ""
		}
	    }
	}

	size {
	    set id [lindex $misc(columns) 0]
	    set result [$widgets(listbox$id) size]
	}
    }

    # if the user has a selectcommand defined and the selection changed,
    # run the selectcommand
    if {[info exists priorSelection] && $options(-selectcommand) != ""} {
	set column [lindex $misc(columns) 0]
	set currentSelection [$widgets(listbox$column) curselection]
	if {[string compare $priorSelection $currentSelection] != 0} {
	    # this logic keeps us from getting into some sort of
	    # infinite loop of the selectcommand changes the selection
	    # (not particularly well tested, but it seems like the
	    # right thing to do...)
	    if {![info exists misc(skipRecursiveCall)]} {
		set misc(skipRecursiveCall) 1
		uplevel \#0 $options(-selectcommand) $currentSelection
                if {[info exists misc(skipRecursiveCall)]} {
		    unset misc(skipRecursiveCall)
                }
	    }
	}
    }

    # ericm@scriptics.com
    # If there is exactly ONE thing selected, then enable the edit buttons
    set column [lindex $misc(columns) 0]
    if { ![string equal $column ""] } {
	set cursel [$widgets(listbox$column) curselection]
	set cmd    $options(-iseditableindexcommand)
	set state  disabled
	if { [string equal $cmd ""] } {
	    if {[llength $cursel] == 1} {
		set state normal
	    }
	} else {
	    if { [llength $cursel] } {
		if { [uplevel \#0 $cmd $w $cursel] } {
		    set state normal
		}
	    }
	}
        if {[string equal $options(-state) normal]} {
	    foreach editbutton [array names widgets editbutton*] {
	        $widgets($editbutton) configure -state $state
	    }
        }
    }
    # ericm@scriptics.com

    return $result
}

# ::mclistbox::WidgetProc-get --
#
#    Implements the "get" widget command
#
# Arguments:
#
#    w      widget path
#    args   additional arguments to the get command

proc ::mclistbox::WidgetProc-get {w args} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    set returnType "list"
    # the listbox "get" command returns different things
    # depending on whether it has one or two args. Internally
    # we *always* want a valid list, so we'll force a second
    # arg which in turn forces the listbox to return a list,
    # even if its a list of one element
    if {[llength $args] == 1} {
	lappend args [lindex $args 0]
	set returnType "listOfLists"
    }

    # get all the data from each column
    foreach id $misc(columns) {
	set data($id) [eval {$widgets(listbox$id)} get $args]
    }

    # now join the data together one row at a time. Ugh.
    set result {}
    set rows [llength $data($id)]
    for {set i 0} {$i < $rows} {incr i} {
	set this {}
	foreach column $misc(columns) {
	    lappend this [lindex $data($column) $i]
	}
	lappend result $this
    }
    
    # now to unroll the list if necessary. If the user gave
    # us only one indicie we want to return a single list
    # of values. If they gave use two indicies we want to return
    # a list of lists.
    if {[string compare $returnType "list"] == 0} {
	return $result
    } else {
	return [lindex $result 0]
    }
}

# ::mclistbox::CheckColumnID --
#
#    returns the index of the id within our list of columns, or 
#    reports an error if the id is invalid
#
# Arguments:
#
#    w    widget pathname
#    id   a column id
#
# Results:
#
#   Will compute and return the index of the column within the
#   list of columns (which happens to be it's -position, as it
#   turns out) or returns an error if the named column doesn't
#   exist.

proc ::mclistbox::CheckColumnID {w id} {
    upvar ::mclistbox::${w}::misc    misc

    set id [::mclistbox::Canonize $w column $id]
    set index [lsearch -exact $misc(columns) $id]
    return $index
}

# ::mclistbox::LabelEvent --
#
#    Handle user events on the column labels for the Mclistbox
#    class. 
#
# Arguments:
#
#    w        widget pathname
#    id       a column identifier
#    code     tcl code to be evaluated.
#
# Results:
#
#    Executes the code associate with an event, but only if the
#    event wouldn't otherwise potentially trigger a resize event.
#
#    We use the cursor of the label to let us know whether the
#    code should be executed. If it is set to the cursor of the
#    mclistbox widget, the code will be executed. It is assumed
#    that if it is not the same cursor, it is the resize cursor
#    which should only be set if the cursor is very near a border
#    of a label and the column is resizable.

proc ::mclistbox::LabelEvent {w id code} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options

    # only fire the binding if the cursor is our default cursor
    # (ie: if we aren't in a "resize zone")
    set cursor [$widgets(label$id) cget -cursor]
    if {[string compare $cursor $options(-cursor)] == 0} {
	uplevel \#0 $code
    }
}

# ::mclistbox::HumanizeList --
#
#    Returns a human-readable form of a list by separating items
#    by columns, but separating the last two elements with "or"
#    (eg: foo, bar or baz)
#
# Arguments:
#
#    list    a valid tcl list
#
# Results:
#
#    A string which as all of the elements joined with ", " or 
#    the word " or "

proc ::mclistbox::HumanizeList {list} {

    if {[llength $list] == 1} {
	return [lindex $list 0]
    } else {
	set list [lsort $list]
	set secondToLast [expr {[llength $list] -2}]
	set most [lrange $list 0 $secondToLast]
	set last [lindex $list end]

	return "[join $most {, }] or $last"
    }
}

# ::mclistbox::Canonize --
#
#    takes a (possibly abbreviated) option or command name and either 
#    returns the canonical name or an error
#
# Arguments:
#
#    w        widget pathname
#    object   type of object to canonize; must be one of "command",
#             "option", "column" or "column option".
#    opt      the option (or command) to be canonized
#
# Returns:
#
#    Returns either the canonical form of an option or command,
#    or raises an error if the option or command is unknown or
#    ambiguous.

proc ::mclistbox::Canonize {w object opt} {
    variable widgetOptions
    variable columnOptions
    variable widgetCommands
    variable columnCommands
    variable labelCommands

    switch $object {
	command {
	    if {[lsearch -exact $widgetCommands $opt] >= 0} {
		return $opt
	    }

	    # command names aren't stored in an array, and there
	    # isn't a way to get all the matches in a list, so
	    # we'll stuff the columns in a temporary array so
	    # we can use [array names]
	    set list $widgetCommands
	    foreach element $list {
		set tmp($element) ""
	    }
	    set matches [array names tmp ${opt}*]
	}

	{label command} {
	    if {[lsearch -exact $labelCommands $opt] >= 0} {
		return $opt
	    }

	    # command names aren't stored in an array, and there
	    # isn't a way to get all the matches in a list, so
	    # we'll stuff the columns in a temporary array so
	    # we can use [array names]
	    set list $labelCommands
	    foreach element $list {
		set tmp($element) ""
	    }
	    set matches [array names tmp ${opt}*]
	}

	{column command} {
	    if {[lsearch -exact $columnCommands $opt] >= 0} {
		return $opt
	    }

	    # command names aren't stored in an array, and there
	    # isn't a way to get all the matches in a list, so
	    # we'll stuff the columns in a temporary array so
	    # we can use [array names]
	    set list $columnCommands
	    foreach element $list {
		set tmp($element) ""
	    }
	    set matches [array names tmp ${opt}*]
	}

	option {
	    if {[info exists widgetOptions($opt)] \
		    && [llength $widgetOptions($opt)] == 3} {
		return $opt
	    }
	    set list [array names widgetOptions]
	    set matches [array names widgetOptions ${opt}*]
	}

	{column option} {
	    if {[info exists columnOptions($opt)]} {
		return $opt
	    }
	    set list [array names columnOptions]
	    set matches [array names columnOptions ${opt}*]
	}

	column {
	    upvar ::mclistbox::${w}::misc    misc

	    if {[lsearch -exact $misc(columns) $opt] != -1} {
		return $opt
	    }
	    
	    # column names aren't stored in an array, and there
	    # isn't a way to get all the matches in a list, so
	    # we'll stuff the columns in a temporary array so
	    # we can use [array names]
	    set list $misc(columns)
	    foreach element $misc(columns) {
		set tmp($element) ""
	    }
	    set matches [array names tmp ${opt}*]
	}
    }
    if {[llength $matches] == 0} {
	set choices [HumanizeList $list]
	error "unknown $object \"$opt\"; must be one of $choices"

    } elseif {[llength $matches] == 1} {
	# deal with option aliases
	set opt [lindex $matches 0]
	switch $object {
	    option {
		if {[llength $widgetOptions($opt)] == 1} {
		    set opt $widgetOptions($opt)
		}
	    }

	    {column option} {
		if {[llength $columnOptions($opt)] == 1} {
		    set opt $columnOptions($opt)
		}
	    }
	}

	return $opt

    } else {
	set choices [HumanizeList $list]
	error "ambiguous $object \"$opt\"; must be one of $choices"
    }
}

# ::mclistbox::Configure --
#
#    Implements the "configure" widget subcommand
#
# Arguments:
#
#    w      widget pathname
#    args   zero or more option/value pairs (or a single option)
#
# Results:
#    
#    Performs typcial "configure" type requests on the widget
 
proc ::mclistbox::Configure {w args} {
    variable widgetOptions

    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc
    
    if {[llength $args] == 0} {
	# hmmm. User must be wanting all configuration information
	# note that if the value of an array element is of length
	# one it is an alias, which needs to be handled slightly
	# differently
	set results {}
	foreach opt [lsort [array names widgetOptions]] {
	    if {[llength $widgetOptions($opt)] == 1} {
		set alias $widgetOptions($opt)
		set optName $widgetOptions($alias)
		lappend results [list $opt $optName]
	    } else {
		set optName  [lindex $widgetOptions($opt) 0]
		set optClass [lindex $widgetOptions($opt) 1]
		set default [option get $w $optName $optClass]
		lappend results [list $opt $optName $optClass \
			$default $options($opt)]
	    }
	}

	return $results
    }
    
    # one argument means we are looking for configuration
    # information on a single option
    if {[llength $args] == 1} {
	set opt [::mclistbox::Canonize $w option [lindex $args 0]]

	set optName  [lindex $widgetOptions($opt) 0]
	set optClass [lindex $widgetOptions($opt) 1]
	set default [option get $w $optName $optClass]
	set results [list $opt $optName $optClass \
		$default $options($opt)]
	return $results
    }

    # if we have an odd number of values, bail. 
    if {[expr {[llength $args]%2}] == 1} {
	# hmmm. An odd number of elements in args
	error "value for \"[lindex $args end]\" missing"
    }
    
    # Great. An even number of options. Let's make sure they 
    # are all valid before we do anything. Note that Canonize
    # will generate an error if it finds a bogus option; otherwise
    # it returns the canonical option name
    foreach {name value} $args {
	set name [::mclistbox::Canonize $w option $name]
	set opts($name) $value
    }

    # process all of the configuration options
    foreach option [array names opts] {

	set newValue $opts($option)
	if {[info exists options($option)]} {
	    set oldValue $options($option)
#	    set options($option) $newValue
	}

	switch -- $option {
	    -exportselection {
		if {$newValue} {
		    SelectionHandler $w own
		    set options($option) 1
		} else {
		    set options($option) 0
		}
	    }

	    -fillcolumn {
		# if the fill column changed, we need to adjust
		# the columns.
		AdjustColumns $w
		set options($option) $newValue
	    }

	    -takefocus {
		$widgets(frame) configure -takefocus $newValue
		set options($option) [$widgets(frame) cget $option]
	    }

	    -background {
		foreach id $misc(columns) {
		    $widgets(listbox$id) configure -background $newValue
		    $widgets(frame$id) configure   -background $newValue
		}
		$widgets(frame) configure -background $newValue

		$widgets(text) configure -background $newValue
		set options($option) [$widgets(frame) cget $option]
	    }

	    -foreground -
	    -font -
	    -selectborderwidth -
	    -selectforeground -
	    -selectbackground -
	    -setgrid {
		# { the following all must be applied to each listbox }
		foreach id $misc(columns) {
		    $widgets(listbox$id) configure $option $newValue
		}
		$widgets(hiddenListbox) configure $option $newValue
		set options($option) [$widgets(hiddenListbox) cget $option]
	    }
            -state {
		set newValue [string tolower $newValue]
		set vals [list "normal" "disabled"]
		if { [lsearch $vals $newValue] == -1 } {
		    error "bad state \"$newValue\": must be disabled or normal"
		}
		set options($option) $newValue

                if {[string equal $newValue "disabled"]} {
		    
                    foreach id $misc(columns) {
		        $widgets(label$id) configure -state $newValue
                        set fgcolor [$widgets(label$id) cget -disabledforeground]
                        $widgets(listbox$id) configure -foreground $fgcolor
                        set misc(oldSelect$id) [$widgets(listbox$id) curselection]
  		        $widgets(listbox$id) selection clear 0 end
		    }
 	            foreach editbutton [array names widgets editbutton*] {
	                $widgets($editbutton) configure -state disabled
	            }

		} else {
                    foreach id $misc(columns) {
		        $widgets(label$id) configure -state $newValue
                        $widgets(listbox$id) configure \
                                -foreground $options(-foreground)
                        if {[info exists misc(oldSelect$id)]} {
		            foreach index $misc(oldSelect$id) {
                                $widgets(listbox$id) selection set $index
                            }
			}
                    }
		}
            }
	    -cursor {
		# { these must be applied to each listbox and frame }
		foreach id $misc(columns) {
		    $widgets(listbox$id) configure $option $newValue
		    $widgets(frame$id) configure -cursor $newValue
		}

		# -cursor also needs to be applied to the 
		# frames of each column
		foreach id $misc(columns) {
		    $widgets(frame$id) configure -cursor $newValue
		}

		$widgets(hiddenListbox) configure $option $newValue
		set options($option) [$widgets(hiddenListbox) cget $option]
	    }

	    -labels {
		# { this just requires to pack or unpack the labels }
		if {$newValue} {
		    set newValue 1
		    foreach id $misc(columns) {
			pack $widgets(label$id) \
				-side top -fill x -expand n \
				-before $widgets(listbox$id)
		    }
		    pack $widgets(hiddenLabel) \
			    -side top -fill x -expand n \
			    -before $widgets(hiddenListbox)

		} else {
		    set newValue 
		    foreach id $misc(columns) {
			pack forget $widgets(label$id)
		    }
		    pack forget $widgets(hiddenLabel)
		}
		set options($option) $newValue
	    }

	    -height {
		$widgets(hiddenListbox) configure -height $newValue
		InvalidateScrollbars $w
		set options($option) [$widgets(hiddenListbox) cget $option]
	    }

	    -width {
		if {$newValue == 0} {
		    error "a -width of zero is not supported. "
		}

		$widgets(hiddenListbox) configure -width $newValue
		InvalidateScrollbars $w
		set options($option) [$widgets(hiddenListbox) cget $option]
	    }

	    -columnborderwidth -
	    -columnrelief {
		# { these must be applied to each column frame }
		regsub {column} $option {} listboxoption
		foreach id $misc(columns) {
		    $widgets(listbox$id) configure $listboxoption $newValue
		}
		$widgets(hiddenListbox) configure $listboxoption $newValue
		set options($option) [$widgets(hiddenListbox) cget \
			$listboxoption]
	    }

	    -resizablecolumns {
		if {$newValue} {
		    set options($option) 1
		} else {
		    set options($option) 0
		}
	    }
	    
	    -labelimage -
	    -labelheight -
	    -labelrelief -
	    -labelfont -
	    -labelanchor -
	    -labelbackground -
	    -labelforeground -
	    -labelborderwidth {
		# { these must be applied to each column header }
		regsub {label} $option {} labeloption
		foreach id $misc(columns) {
		    $widgets(label$id) configure $labeloption $newValue
		}
		$widgets(hiddenLabel) configure $labeloption $newValue
		set options($option) [$widgets(hiddenLabel) cget $labeloption]
	    }

	    -borderwidth -
	    -highlightthickness -
	    -highlightcolor -
	    -highlightbackground -
	    -relief {
		# { these apply only to the topmost frame}
		$widgets(frame) configure $option $newValue
		set options($option) [$widgets(frame) cget $option]
	    }

	    -selectmode {
		set options($option) $newValue
	    }

	    -selectcommand {
		set options($option) $newValue
	    }

	    -xscrollcommand {
		InvalidateScrollbars $w
		set options($option) $newValue
	    }

	    -yscrollcommand {
		InvalidateScrollbars $w
		set options($option) $newValue
	    }

	    -dropcursor {
		# bwidget stuff
		set newValue [string tolower $newValue]
		set vals [list "after" "before" "none" "on"]
		if { [lsearch $vals $newValue] == -1 } {
		    error "invalid dropcursor value \"$newValue\": should\
			    be one of after, before, none, or on"
		}
		set options($option) $newValue
	    }

	    -iseditableindexcommand {
		# Used to determine if the edit buttons should be 
		# enabled or disabled.
		set options($option) $newValue
	    }

	}
    }
}

# ::mclistbox::UpdateScrollbars --
#
#    This proc does the work of actually update the scrollbars to
#    reflect the current view
#
# Arguments:
#
#    w      widget pathname
#
# Results:
#
#    Potentially changes the size or placement of the scrollbars
#    (if any) based on changes to the widget

proc ::mclistbox::UpdateScrollbars {w} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    if {![winfo ismapped $w]} {
        if {[info exists misc(afterid)]} {
	    unset misc(afterid)
        }
	return
    }

    update idletasks
    if {[llength $misc(columns)] > 0} {
	if {[string length $options(-yscrollcommand)] != 0} {
	    set col0 [lindex $misc(columns) 0]
	    set yview [$widgets(listbox$col0) yview]
	    eval $options(-yscrollcommand) $yview
	}

	if {[string length $options(-xscrollcommand)] != 0} {
	    set col0 [lindex $misc(columns) 0]
	    set xview [$widgets(text) xview]
	    eval $options(-xscrollcommand) $xview
	}
    }
    if {[info exists misc(afterid)]} {  
        unset misc(afterid)
    }
}

# ::mclistbox::InvalidateScrollbars --
#
#    Schedules the scrollbars to be updated the next time 
#    we are idle.
#
# Arguments:
#
#    w     widget pathname
#
# Results:
#
#    sets up a proc to be run in the idle event handler

proc ::mclistbox::InvalidateScrollbars {w args} {

    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    if {![info exists misc(afterid)]} {
	set misc(afterid) \
		[after idle "catch {::mclistbox::UpdateScrollbars $w}"]
    }
}

# ::mclistbox::Insert --
#
#    This implements the "insert" widget command; it arranges for 
#    one or more elements to be inserted into the listbox.
#
# Arguments:
#
#    w         widget pathname
#    index     a valid listbox index to designate where the data is
#              to be inserted
#    arglist   A list of values to be inserted. Each element of the
#              list will itself be treated as a list, one element for
#              each column.
#
# Results:
#
#    Inserts the data into the list and updates the scrollbars

proc ::mclistbox::Insert {w index arglist} {

    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    foreach list $arglist {
	# make sure we have enough elements for each column
	for {set i [llength $list]} {$i < [llength $misc(columns)]} {incr i} {
	    lappend list {}
	}

	set column 0
	foreach id $misc(columns) {
	    $widgets(listbox$id) insert $index [lindex $list $column]
	    incr column
	}

	# we also want to add a bogus item to the hidden listbox. Why?
	# For standard listboxes, if you specify a height of zero the
	# listbox will resize to be just big enough to hold all the lines.
	# Since we use a hidden listbox to regulate the size of the widget
	# and we want this same behavior, this listbox needs the same number
	# of elements as the visible listboxes
	#
	# (NB: we might want to make this listbox contain the contents
	# of all columns as a properly formatted list; then the get 
	# command can query this listbox instead of having to query
	# each individual listbox. The disadvantage is that it doubles
	# the memory required to hold all the data)
	$widgets(hiddenListbox) insert $index "x"
    }
    return ""
}

# ::mclistbox::ColumnIsHidden --
#
#    Returns a boolean representing whether a column is visible or
#    not
#
# Arguments:
#
#    w     widget pathname
#    id    a column identifier
#
# Results:
#
#    returns 1 if the column is visible (ie: not hidden), or 0
#    if invisible. Note that the result doesn't consider whether
#    the column is actually viewable. Even if it has been scrolled
#    off screen, 1 will be returned as long as the column hasn't
#    been hidden by turning the visibility off.

proc ::mclistbox::ColumnIsHidden {w id} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::misc    misc
    
    set retval 1
    set col [lsearch -exact $misc(columns) $id]

    if {$col != ""} {
	set index "1.$col"
	catch {
	    set window [$widgets(text) window cget $index -window]
	    if {[string length $window] > 0 && [winfo exists $window]} {
		set retval 0
	    }
	}
    }
    return $retval
}

# ::mclistbox::AdjustColumns --
#
#    Adjusts the height and width of the individual columns.
#
# Arguments:
#
#    w       widget pathname
#    height  height, in pixels, that the columns should be adjusted
#            to. If null, the height will be the height of the text
#            widget that underlies our columns.
#
# Results:
#
#    All columns will be adjusted to fill the text widget in the y
#    direction. Also, if a -fillcolumn is defined, that column will
#    be grown, if necessary, to fill the widget in the x direction.

proc ::mclistbox::AdjustColumns {w {height ""}} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    upvar ::mclistbox::${w}::misc    misc

    if {[string length $height] == 0} {
	set height [winfo height $widgets(text)]
    }

    # resize the height of each column so it matches the height
    # of the text widget.
 
    foreach id $misc(columns) {
	$widgets(frame$id) configure -height $height
    }
    
    # START ericm@scriptics.com
    # if any columns have a zero width, compute their real width
    foreach id $misc(columns) {
	if { ![ColumnIsHidden $w $id] } {
	    if { $misc(min-$widgets(frame$id)) == 0 } {
                set count [$widgets(listbox$id) index end]
                set maxw 0
                set columnLabel [$widgets(label$id) cget -text]
                if {$columnLabel != ""} {
                    set maxw [font measure $options(-font) $columnLabel]
                }
		for { set i 0 } { $i < $count } { incr i } {
		    set thisw [font measure $options(-font) \
			    [$widgets(listbox$id) get $i]]
		    if { $thisw > $maxw } {
			set maxw $thisw
		    }
		}
		incr maxw [font measure $options(-font) "0"]
		set misc(min-$widgets(frame$id)) $maxw
		$widgets(frame$id) configure -width $maxw
	    }
	}
    }
    # END ericm@scriptics.com

    # if we have a fillcolumn, change its width accordingly
    if {$options(-fillcolumn) != ""} {

	# make sure the column has been defined. If not, bail (?)
	if {![info exists widgets(frame$options(-fillcolumn))]} {
	    return
	}
	set frame $widgets(frame$options(-fillcolumn))
	set minwidth $misc(min-$frame)

	# compute current width of all columns
	set colwidth 0
	set col 0
	foreach id $misc(columns) {
	    if {![ColumnIsHidden $w $id] && $id != $options(-fillcolumn)} {
		incr colwidth [winfo reqwidth $widgets(frame$id)]
	    }
	}

	# this is just shorthand for later use...
	set id $options(-fillcolumn)

	# compute optimal width
	set optwidth [expr {[winfo width $widgets(text)] - \
		(2 * [$widgets(text) cget -padx])}]

	# compute the width of our fill column
	set newwidth [expr {$optwidth - $colwidth}]

	if {$newwidth < $minwidth} {
	    set newwidth $minwidth
	}

	# adjust the width of our fill column frame
	$widgets(frame$id) configure -width $newwidth
	    
    }
    InvalidateScrollbars $w
}

# ::mclistbox::FindResizableNeighbor --
#
#    Returns the nearest resizable column to the left or right
#    of the named column. 
#
# Arguments:
#
#    w          widget pathname
#    id         column identifier
#    direction  should be one of "right" or "left". Actually, anything
#               that doesn't match "right" will be treated as "left"
#
# Results:
#
#    Will return the column identifier of the nearest resizable
#    column, or an empty string if none exists. 

proc ::mclistbox::FindResizableNeighbor {w id {direction right}} {
    upvar ::mclistbox::${w}::widgets       widgets
    upvar ::mclistbox::${w}::options       options
    upvar ::mclistbox::${w}::misc          misc


    if {$direction == "right"} {
	set incr 1
	set stop [llength $misc(columns)]
	set start [expr {[lsearch -exact $misc(columns) $id] + 1}]
    } else {
	set incr -1
	set stop -1
	set start [expr {[lsearch -exact $misc(columns) $id] - 1}]
    } 

    for {set i $start} {$i != $stop} {incr i $incr} {
	set col [lindex $misc(columns) $i]
	if {![ColumnIsHidden $w $col] && $options($col:-resizable)} {
	    return $col
	}
    }
    return ""
}

# ::mclistbox::ResizeEvent --
#
#    Handles the events which implement interactive column resizing
#    using the mouse.
#
# Arguments:
#
#    w        widget pathname
#    type     type of event; must be one of "buttonpress", "drag",
#             "motion", or "buttonrelease"
#    widget   the actual widget that the event occured over
#    x        the x coordinate of the mouse, relative to $widget
#    X        the root x coordinate of the mouse
#    Y        the root y coordinate of the mouse
#
# The basic idea is this:
#
# whenever the cursor moves over the label, we examine it's x
# coordinate to determine if its within a fixed amount of
# pixels from the left or right edge. If it is, we reconfigure
# the cursor to be a suitable "this thing is resizable" cursor.
#
# On a buttonclick, if the cursor is not the default cursor 
# (and thus, presumably the resize cursor), we set up some
# state for an eventual resize. We figure out which columns
# are to the left and right and base a maximum resize amount
# for each direction. We also define the absolute X coordinate
# of the buttonpress as a reference point for the drag.
#
# on a b1-motion, if the drag state exists, we look at the 
# absolute X value and use it to compute a delta value from
# the reference (the X of the button press). We then resize the
# left and right column frames by the delta amount.
#
# on a button release, we unset the state and the cursor, which
# cancels all of the above.

proc ::mclistbox::ResizeEvent {w type widget x X Y} {

    upvar ::mclistbox::${w}::widgets       widgets
    upvar ::mclistbox::${w}::options       options
    upvar ::mclistbox::${w}::misc          misc
    upvar ::mclistbox::${w}::columnID      columnID

    # if the widget doesn't allow resizable cursors, there's
    # nothing here to do...
    if {!$options(-resizablecolumns)} {
	return
    }

    # this lets us keep track of some internal state while
    # the user is dragging the mouse
    variable drag

    # this lets us define a small window around the edges of
    # the column. 
    set threshold [expr {$options(-labelborderwidth) + 4}]

    # this is what we use for the "this is resizable" cursor
    set resizeCursor sb_h_double_arrow

    # if we aren't over an area that we care about, bail.
    if {![info exists columnID($widget)]} {
	return
    }

    # id refers to the column name
    set id $columnID($widget)

    switch $type {

	buttonpress {
	    # we will do all the work of initiating a drag only if
	    # the cursor is not the defined cursor. In theory this
	    # will only be the case if the mouse moves over the area
	    # in which a drag can happen.
	    if {[$widgets(label$id) cget -cursor] == $resizeCursor} {
		if {$x <= $threshold} {
		    set lid [::mclistbox::FindResizableNeighbor $w $id left]
		    if {$lid == ""} return
		    set drag(leftFrame)  $widgets(frame$lid)
		    set drag(rightFrame) $widgets(frame$id)

		    set drag(leftListbox)  $widgets(listbox$lid)
		    set drag(rightListbox) $widgets(listbox$id)

		} else {
		    set rid [::mclistbox::FindResizableNeighbor $w $id right]
		    if {$rid == ""} return
		    set drag(leftFrame)  $widgets(frame$id)
		    set drag(rightFrame) $widgets(frame$rid)

		    set drag(leftListbox)  $widgets(listbox$id)
		    set drag(rightListbox) $widgets(listbox$rid)

		}
		

		set drag(leftWidth)  [winfo width $drag(leftFrame)]
		set drag(rightWidth) [winfo width $drag(rightFrame)]

		# it seems to be a fact that windows can never be 
		# less than one pixel wide. So subtract that one pixel
		# from our max deltas...
		set drag(maxDelta)   [expr {$drag(rightWidth) - 1}]
		set drag(minDelta)  -[expr {$drag(leftWidth) - 1}]

		set drag(x) $X
	    }
	}

	motion {
	    if {[info exists drag(x)]} {return}

	    # this is just waaaaay too much work for a motion 
	    # event, IMO.

	    set resizable 0

	    # is the column the user is over resizable?
	    if {!$options($id:-resizable)} {return}

	    # did the user click on the left of a column? 
	    if {$x < $threshold} {
		set leftColumn [::mclistbox::FindResizableNeighbor $w $id left]
		if {$leftColumn != ""} {
		    set resizable 1
		}

	    } elseif {$x > [winfo width $widget] - $threshold} {
		set rightColumn [::mclistbox::FindResizableNeighbor $w $id \
			right]
		if {$rightColumn != ""} {
		    set resizable 1
		}
	    }

	    # if it's resizable, change the cursor 
	    set cursor [$widgets(label$id) cget -cursor]
	    if {$resizable && $cursor != $resizeCursor} {
		$widgets(label$id) configure -cursor $resizeCursor

	    } elseif {!$resizable && $cursor == $resizeCursor} {
		$widgets(label$id) configure -cursor $options(-cursor)
	    }
	}

	drag {
	    # if the state is set up, do the drag...
	    if {[info exists drag(x)]} {

		set delta [expr {$X - $drag(x)}]
		if {$delta >= $drag(maxDelta)} {
		    set delta $drag(maxDelta)

		} elseif {$delta <= $drag(minDelta)} {
		    set delta $drag(minDelta)
		}

		set lwidth [expr {$drag(leftWidth) + $delta}]
		set rwidth [expr {$drag(rightWidth) - $delta}]

		$drag(leftFrame)   configure -width $lwidth
		$drag(rightFrame)  configure -width $rwidth

	    }
	}

	buttonrelease {
	    set fillColumnID $options(-fillcolumn)
	    if {[info exists drag(x)] && $fillColumnID != {}} {
		set fillColumnFrame $widgets(frame$fillColumnID)
		if {[string compare $drag(leftFrame) $fillColumnFrame] == 0 \
			|| [string compare $drag(rightFrame) $fillColumnFrame] == 0} {
		    set width [$fillColumnFrame cget -width]
		    set misc(minFillColumnSize) $width
		}
		set misc(min-$drag(leftFrame))  [$drag(leftFrame) cget -width]
		set misc(min-$drag(rightFrame)) [$drag(rightFrame) cget -width]
	    }

	    # reset the state and the cursor
            if {[info exists drag]} {
	        unset drag
            }
	    $widgets(label$id) configure -cursor $options(-cursor)

	}
    }
}

# ::mclistbox::_init_drag_cmd --
#
#	Called in response to a BWidget drag-and-drop "start drag" event.
#
# Arguments:
#	path      path receiving the event
#       X         root X coord of the event
#       Y         root Y coord of the event
#       top       toplevel created to represent the dragged data.
#
# Results:
#	{type {ops} data}
#       type     type of the data
#       ops      list of acceptable operations (copy, move and link)
#       data     the dragged data

proc ::mclistbox::_init_drag_cmd {path X Y top} {
    set path  [::mclistbox::convert $path -W]
    upvar ::mclistbox::${path}::options options

    if {[info exists options(dragIndex)]} {

        set index $options(dragIndex)

    } else {

        # I don't think this will ever happen.. We should always get a button
        # press event before the drag init is called.

        set index 0
    }

    set cmd   $options(-draginitcmd)
    if { ![string equal $cmd ""] } {
	return [uplevel \#0 $cmd [list $path $index $top]]
    }
    return [list "LISTBOX_ITEM" {copy move} $index]
}

# ::mclistbox::_over_cmd --
#
#	Respond to a BWidget drag-and-drop "over" event.
#
# Arguments:
#	path            target of the over event
#       source          source of the drag event
#       event           one of enter, motion or leave
#       X               root X coord of the event
#       Y               root Y coord of the event
#       op              operation, one of copy, move or link
#       type            type of dragged data
#       data            dragged data
#
# Results:
#	0        to refuse drag
#       1        to accept but prevent future calls to _over_cmd
#       2        to refuse drag but allow future calls to re-evaluate
#       3        to accept drag and allow future calls to _over_cmd

proc ::mclistbox::_over_cmd {path source event X Y op type data} {
    set index [$path nearest [expr {$Y - [winfo rooty $path]}]]
    set listbox $path
    set path  [::mclistbox::convert $path -W]
    upvar ::mclistbox::${path}::options options
    upvar ::mclistbox::${path}::misc    misc
    upvar ::mclistbox::${path}::widgets widgets
    set cmd $options(-dropovercmd)
    if { ![string equal $cmd ""] } {
	set res [uplevel \#0 $cmd [list \
		$path $source $event $index $op $type $data]]
    } else {
	set res 3
    }

    if { [expr {$res & 1}] && $event != "leave" } {
	switch -exact -- $options(-dropcursor) {
	    "before" -
	    "after" {
		if { ![winfo exists $path._dragframe] } {
		    frame $path._dragframe -height 2 -bg black
		    DropSite::register $path._dragframe \
			    -droptypes $options(-droptypes) \
			    -dropovercmd ::mclistbox::_over_drag_frame_cmd \
			    -dropcmd     ::mclistbox::_drop_drag_frame_cmd
		}
		set bbox [$path bbox $index]
		if { [string equal $bbox ""] } {
		    # If bbox is null (ie, there's nothing in the listbox),
		    # we have to do some tricks to get some realistic coords
		    # for the dropcursor
		    set x1 0
		    set h1 0
		    set i [expr [llength $misc(columns)] - 1]
		    set id [lindex $misc(columns) $i]
		    while { $i && ![expr {$options($id:-visible)}] } {
			incr i -1
			set id [lindex $misc(columns) $i]
		    }
		    set w1 [expr {[winfo width $widgets(frame$id)] + \
			    [winfo x $widgets(frame$id)]}]
		    set y1 [winfo y $widgets(listbox$id)]
		} else {
		    foreach {x1 y1 w1 h1} $bbox break
		}
		# decr y1 to account for bbox's overestimate
		incr y1 -1
		if { [string equal $options(-dropcursor) "before"] } {
		    # decr y1 to account for frame height
		    incr y1 -2
		    # decr y1 by the selectborderwidth
		    incr y1 [expr {[$path cget -selectborderwidth] * -1}]
		} else {
		    incr y1 $h1
		}
		place $path._dragframe -in $path -x 0 -y $y1 -width $w1
	    }
	    "on" {
		$path selection clear 0 end
		$path selection set $index
	    }
	}

        DropSite::setcursor based_arrow_down
    } else {
	if { [winfo exists $path._dragframe] } {
	    destroy $path._dragframe
	}
        DropSite::setcursor dot
    }

    # Scrolling is a major pain in the butt, but it's really necessary.
    # The model we use is this:  define two "hot spots", one at the top
    # and one at the bottom of the list; if during an over event, the
    # cursor enters one of these areas, set a timer event to scroll the
    # listbox appropriately.  When the cursor leaves the hot spot,
    # or when the drag ends, cancel the timer events.
    set bbox [$listbox bbox $index]
    if { ![string equal $bbox ""] } {
	foreach {x1 y1 w1 h1} $bbox break
	set top1 [winfo rooty $listbox]
	set top2 [expr {$top1 + $h1}]
	set bot2 [expr {[winfo height $listbox] + $top1}]
	set bot1 [expr {$bot2 - $h1}]
	if { $event == "leave" } {
	    # In all cases, a leave definately cancels the scrolling
	    if { [info exists ::mclistbox::_scrollTimer($path)] } {
		after cancel $::mclistbox::_scrollTimer($path)
		unset ::mclistbox::_scrollTimer($path)
	    }
	} else {
	    if { $res & 1 } {
		foreach {first last} [$path yview] break
		# If we are accepting this drag, we can scroll the list
		if { $top1 < $Y && $Y < $top2 && $first != 0 } {
		    if { ![info exists ::mclistbox::_scrollTimer($path)] } {
			set ::mclistbox::_scrollTimer($path) \
				[after 200 [list ::mclistbox::Scroll $path -1]]
		    }
		} elseif { $bot1 < $Y && $Y < $bot2 && $last != 1 } {
		    if { ![info exists ::mclistbox::_scrollTimer($path)] } {
			set ::mclistbox::_scrollTimer($path) \
				[after 200 [list ::mclistbox::Scroll $path 1]]
		    }
		} else {
		    if { [info exists ::mclistbox::_scrollTimer($path)] } {
			after cancel $::mclistbox::_scrollTimer($path)
			unset ::mclistbox::_scrollTimer($path)
		    }
		}
	    } else {
		if { [info exists ::mclistbox::_scrollTimer($path)] } {
		    after cancel $::mclistbox::_scrollTimer($path)
		    unset ::mclistbox::_scrollTimer($path)
		}
	    }	    
	}
    }
    
    return $res
}

# ::mclistbox::_drag_end_cmd --
#
#	Cleanup after a drag event.
#
# Arguments:
#	path            target of the over event
#       source          source of the drag event
#       op              operation, one of copy, move or link
#       type            type of dragged data
#       data            dragged data
#       result          result of target's -dropcmd
#
# Results:
#	None.

proc ::mclistbox::_drag_end_cmd {path source op type data result} {
    set path  [::mclistbox::convert $path -W]
    upvar ::mclistbox::${path}::options options
    if { [winfo exists $path._dragframe] } {
	destroy $path._dragframe
    }
    if { [info exists ::mclistbox::_scrollTimer($path)] } {
	after cancel $::mclistbox::_scrollTimer($path)
	unset ::mclistbox::_scrollTimer($path)
    }
    set cmd $options(-dragendcmd)
    if { ![string equal $cmd ""] } {
	return [uplevel \#0 $cmd [list $path $source $op $type $data $result]]
    }
}

# ::mclistbox::_drop_cmd --
#
#	Respond to a BWidget drag-and-drop "drop" event.
#
# Arguments:
#	path            target of the over event
#       source          source of the drag event
#       X               root X coord of the event
#       Y               root Y coord of the event
#       op              operation, one of copy, move or link
#       type            type of dragged data
#       data            dragged data
#
# Results:
#	0               for failed drop
#       1               for successful drop

proc ::mclistbox::_drop_cmd {path source X Y op type data} {
    
    set row [$path nearest [expr {$Y - [winfo rooty $path]}]]
    set path  [::mclistbox::convert $path -W]
    upvar ::mclistbox::${path}::options   options
    upvar ::mclistbox::${path}::misc      misc
    upvar ::mclistbox::${path}::widgets   widgets

    if { [winfo exists $path._dragframe] } {
	destroy $path._dragframe
    }

    set x [expr {$X - [winfo rootx $path]}]
    set tmp [$widgets(text) index @$x,0]
    set tmp [split $tmp "."]
    set index [lindex $tmp 1]
    set column [lindex $misc(columns) $index]

    if { [info exists ::mclistbox::_scrollTimer($path)] } {
	after cancel $::mclistbox::_scrollTimer($path)
	unset ::mclistbox::_scrollTimer($path)
    }
    set cmd $options(-dropcmd)
    if { ![string equal $cmd ""] } {
	return [uplevel \#0 $cmd [list $path $source $row $column $op $type $data]]
    }
    return 0
}

# ::mclistbox::_over_drag_frame_cmd --
#
#	Respond to a BWidget drag-and-drop "over" event on the location
#       indicator frame.
#
# Arguments:
#	path            target of the over event
#       source          source of the drag event
#       event           one of enter, motion or leave
#       X               root X coord of the event
#       Y               root Y coord of the event
#       op              operation, one of copy, move or link
#       type            type of dragged data
#       data            dragged data
#
# Results:
#	0        to refuse drag
#       1        to accept but prevent future calls to _over_cmd
#       2        to refuse drag but allow future calls to re-evaluate
#       3        to accept drag and allow future calls to _over_cmd

proc ::mclistbox::_over_drag_frame_cmd {path source event X Y op type data} {
    # This is pretty gross -- we can't use winfo parent because the dragframe
    # may have been nuked by the "leave" event on the column (ie -- the mouse
    # "left" the column and "entered" the dragframe).
    set win  [file root $path]
    set col  [$win column nearest [expr {$X - [winfo rootx $win]}]]
    set path $win.text.frame${col}.listbox
    return [::mclistbox::_over_cmd $path $source $event $X $Y $op $type $data]
}

# ::mclistbox::_drop_cmd --
#
#	Respond to a BWidget drag-and-drop "drop" event.
#
# Arguments:
#	path            target of the over event
#       source          source of the drag event
#       X               root X coord of the event
#       Y               root Y coord of the event
#       op              operation, one of copy, move or link
#       type            type of dragged data
#       data            dragged data
#
# Results:
#	0               for failed drop
#       1               for successful drop

proc ::mclistbox::_drop_drag_frame_cmd {path source X Y op type data} {
    # This is pretty gross -- we can't use winfo parent because the dragframe
    # may have been nuked by the "leave" event on the column (ie -- the mouse
    # "left" the column and "entered" the dragframe).
    set win  [file root $path]
    set col  [$win column nearest [expr {$X - [winfo rootx $win]}]]
    set path $win.text.frame${col}.listbox

    return [::mclistbox::_drop_cmd $path $source $X $Y $op $type $data]
}

# ::mclistbox::edit --
#
#	Perform an inline edit on a given column and index of the listbox.
#
# Arguments:
#	w       name of the mclistbox megawidget
#	id      column to edit
#	index   index to edit
#	var	name of the variable to fill with a value
#       vcmd    script used to validate the input; if null, no validation
#               will occur.  If non-null, names a function that will be passed
#               the input and will return a boolean indicating whether or not
#               the input should be accepted (1 == good input, 0 == bad).  
#               The edit widget will remain active as long as the input is
#               rejected.

#
# Results:
#	Boolean indicating success or failure of edit (1 == success)

proc ::mclistbox::edit {widget id index var {vcmd ""}} {
    upvar ::mclistbox::${widget}::widgets widgets
    upvar 3 $var result

    # bail if they gave us a bogus id
    if { [CheckColumnID $widget $id] == -1 } {
	error "invalid column $id"
    }

    # define some shorthand
    set listbox $widgets(listbox$id)
    set frame   $widgets(frame$id)

    # If there is already an edit session in progress, bail out. I 
    # am not 100% sure that this is all we have to do, but it sure
    # is better than throwing a stack trace :-).
    if {[winfo exists $listbox._inlineEditFrame]} {
	set result ""
        return 0
    }

    set initval [$listbox get $index]

    # Compute the geometry for the inline editing widget
    # It's computed from the bbox of the text and the select border width.
    set sbw [$listbox cget -selectborderwidth]
    set bbox [$listbox bbox $index]
    if { [string equal $bbox ""] } {
	set result ""
	return 0
    }
    foreach {x y w h} $bbox break
    set  x 0
    incr y [expr {($sbw * -1)}]
    set  w [winfo width $frame]
    incr h [expr {1 + $sbw * 2}]

    # Create the widgets
    set fr  [frame $listbox._inlineEditFrame \
	    -borderwidth 0                   \
	    -highlightthickness 0            \
	    -relief flat]
    set ent [entry $fr.edit       \
	    -borderwidth 1        \
	    -highlightthickness 0 \
	    -relief solid         \
	    -selectborderwidth 0  -font [$listbox cget -font]]
    pack $ent -expand yes -fill both

    # Set up bindings so that we can tell when the user is done
    set ::mclistbox::_edit(wait) 0
    bind $ent <KeyPress-Return> [list set ::mclistbox::_edit(wait) 1]
    bind $ent <KeyPress-Escape> [list set ::mclistbox::_edit(wait) 0]
    bind $fr  <Button>          [list set ::mclistbox::_edit(wait) 3]
    bind $ent <Unmap>           [list set ::mclistbox::_edit(wait) 0]
    set oldBinding [bind $widget <Leave>]
    bind $widget <Leave> {break}
    
    # Setup the entry with the initial value
    $ent insert end $initval
    $ent selection range 0 end
    $ent icursor end
    $ent xview end
    
    # Place the widgets on the screen
    place $fr -in $listbox -x $x -y $y -width $w -height $h
    
    # Make sure they are visible
    tkwait visibility $ent
    
    # Grab input so that the user can't do anything until they finish
    # with the inline edit
    grab $fr

    focus -force $ent
    
    # Wait for the user to finish the edit successfully
    set ok 0
    while { !$ok } {
	vwait ::mclistbox::_edit(wait)
	set result [$ent get]
	if { $::mclistbox::_edit(wait) == 0 } {
	    set ok 1
	} elseif { [string equal $vcmd ""] } {
	    set ok 1
	} else {
	    # edit was committed and vcmd is not null
	    if { [uplevel \#0 $vcmd [list $result]] } {
		set ok 1
	    }
	}
    }

    # Release the gui grab and destroy the inline edit widgets
    grab release $fr
    destroy $fr
    update
    bind $widget <Leave> $oldBinding
    
    if { $::mclistbox::_edit(wait) & 1 } {
	return 1
    }
    set result ""
    return 0
}

# ::mclistbox::editcombo --
#
#	Perform an inline edit on a given column and index of the listbox,
#	using a noneditable BWidget combobox.
#
# Arguments:
#	w	name of the mclistbox megawidget
#	id	column to edit
#	index	index to edit
#	var	name of the variable to place the return result in
#	values	list of initial values for the combobox
#
# Results:
#	boolean indicating success or failure of edit (1 == success)

proc ::mclistbox::editcombo {widget id index var values} {
    upvar 3 $var result
    if { !$::mclistbox::bwidget } {
	set result ""
	return 0
    }

    upvar ::mclistbox::${widget}::widgets widgets
    
    # bail if they gave us a bogus id
    if { [CheckColumnID $widget $id] == -1 } {
	error "invalid column $id"
    }

    # define some shorthand
    set listbox $widgets(listbox$id)
    set frame   $widgets(frame$id)

    # If there is already an edit session in progress, bail out. I 
    # am not 100% sure that this is all we have to do, but it sure
    # is better than throwing a stack trace :-).
    if {[winfo exists $listbox._inlineEditFrame]} {
        set result ""
	return 0
    }

    set initval [$listbox get $index]

    # Compute the geometry for the inline editing widget
    # It's computed from the bbox of the text and the select border width.
    set sbw [$listbox cget -selectborderwidth]
    set bbox [$listbox bbox $index]
    if { [string equal $bbox ""] } {
	set result ""
	return 0
    }
    foreach {x y w h} $bbox break
    set  x 0
    incr y [expr {($sbw * -1)}]
    set  w [winfo width $frame]
    incr h [expr {1 + $sbw * 2}]

    # Create the widgets
    set fr  [frame $listbox._inlineEditFrame \
	    -borderwidth 0                   \
	    -highlightthickness 0            \
	    -relief flat]
    
    set cmb [ComboBox $fr.edit		\
	    -borderwidth 1		\
	    -highlightthickness 0	\
	    -relief solid		\
	    -selectborderwidth 0	\
	    -font [$listbox cget -font]	\
	    -values $values		\
	    -editable false		\
	    -exportselection false	\
	    -modifycmd [list set ::mclistbox::_edit(wait) 1]	\
	    ]
    # Unpack the label that BWidgets puts in the combobox.  We don't like it,
    # we don't want it.  But it's easier to remove it here than it is to modify
    # BWidgets to not pack it unless it's needed.
    pack forget $cmb.labf.l
    pack $cmb -expand yes -fill both

    # Set up bindings so that we can tell when the user is done
    set ::mclistbox::_edit(wait) 0
    bind $cmb.e <KeyPress-Return> [list set ::mclistbox::_edit(wait) 1]
    bind $cmb.e <KeyPress-Escape> [list set ::mclistbox::_edit(wait) 0]
    bind $fr  <Button>          [list set ::mclistbox::_edit(wait) 3]
    set oldBinding [bind $widget <Leave>]
    bind $widget <Leave> {break}
    
    # Setup the entry with the initial value
    $cmb setvalue @[lsearch $values $initval]
    
    # Place the widgets on the screen
    place $fr -in $listbox -x $x -y $y -width $w -height $h
    
    # Make sure they are visible
    tkwait visibility $cmb
    
    # Grab input so that the user can't do anything until they finish
    # with the inline edit
    grab $fr

    focus -force $cmb.e
    
    # Wait for the user to finish the edit successfully
    vwait ::mclistbox::_edit(wait)
    set result [lindex $values [$cmb getvalue]]
    
    # Release the gui grab and destroy the inline edit widgets
    grab release $fr
    destroy $fr
    update
    bind $widget <Leave> $oldBinding
    
    if { $::mclistbox::_edit(wait) & 1 } {
	return 1
    }
    return 0
}

# ::mclistbox::_editButtonCommand --
#
#	Called in response to a click on an edit button.  Calls out to
#       the user specified editcommand for the column that was clicked,
#       if such a command is defined and if something is selected.
#
# Arguments:
#	w         megawidet pathname
#       column    column that was clicked
#
# Results:
#	None.

proc ::mclistbox::_editButtonCommand {w column} {
    upvar ::mclistbox::${w}::widgets widgets
    upvar ::mclistbox::${w}::options options
    
    # Setup some shorthand
    set listbox $widgets(listbox$column)
    set index [$listbox curselection]
    if { [llength $index] != 1 } {
	return
    }
    
    set cmd $options($column:-editcommand)
    if { ![string equal $cmd ""] } {
	uplevel \#0 $cmd $w $column $index
    }
    return
}

# ::mclistbox::Scroll --
#
#	Automatically scroll the listbox up or down, depending on parameters.
#	Register an after event to call this function again.
#
# Arguments:
#	path	mclistbox widget
#	dir	1 or -1, indicating scroll down or scroll up respectively
#
# Results:
#	None.

proc ::mclistbox::Scroll {path dir} {
    foreach {top bottom} [$path yview] break
    if { ($dir == -1 && $top != 0) || ($dir == 1 && $bottom != 1) } {
	$path yview scroll $dir units
	set ::mclistbox::_scrollTimer($path) \
		[after 200 [list ::mclistbox::Scroll $path $dir]]
    } else {
	unset ::mclistbox::_scrollTimer($path)
    }
    return
}



# end of mclistbox.tcl