# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-

#

#	$Id: PanedWin.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $

#

# PanedWin.tcl --

#

#	This file implements the TixPanedWindow widget

#

# Copyright (c) 1993-1999 Ioi Kim Lam.

# Copyright (c) 2000-2001 Tix Project Group.

# Copyright (c) 2004 ActiveState

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

tixWidgetClass tixPanedWindow {

    -classname TixPanedWindow

    -superclass tixPrimitive

    -method {

	add delete forget manage panecget paneconfigure panes setsize

    }

    -flag {

	-command -dynamicgeometry -handleactivebg -handlebg -orient

	-orientation -panebd -paneborderwidth -panerelief

	-separatoractivebg -separatorbg

    }

    -static {

	-orientation

    }

    -configspec {

	{-command command Command ""}

	{-dynamicgeometry dynamicGeometry DynamicGeometry 1 tixVerifyBoolean}

	{-handleactivebg handleActiveBg HandleActiveBg #ececec}

	{-handlebg handleBg Background #d9d9d9}

	{-orientation orientation Orientation vertical}

	{-paneborderwidth paneBorderWidth PaneBorderWidth 1}

	{-panerelief paneRelief PaneRelief raised}

	{-separatoractivebg separatorActiveBg SeparatorActiveBg red}

	{-separatorbg separatorBg Background #d9d9d9}

    }

    -alias {

	{-panebd -paneborderwidth}

	{-orient -orientation}

    }

}

#----------------------------------------------------------------------

# ClassInitialization:

#----------------------------------------------------------------------

proc tixPanedWindow:InitWidgetRec {w} {

    upvar #0 $w data

    tixChainMethod $w InitWidgetRec

    set data(items)       ""

    set data(nItems)      0

    set data(totalsize)   0

    set data(movePending) 0

    set data(repack)      0

    set data(counter)     0

    set data(maxReqW)     1

    set data(maxReqH)     1

}

proc tixPanedWindow:ConstructWidget {w} {

    upvar #0 $w data

    tixChainMethod $w ConstructWidget

    # Do nothing

}

proc tixPanedWindow:SetBindings {w} {

    upvar #0 $w data

    tixChainMethod $w SetBindings

    bind $w <Configure> [list tixPanedWindow:MasterGeomProc $w ""]

}

#----------------------------------------------------------------------

# ConfigOptions:

#----------------------------------------------------------------------

proc tixPanedWindow:config-handlebg {w arg} {

    upvar #0 $w data

    for {set i 1} {$i < $data(nItems)} {incr i} {

	$data(btn,$i) config -bg $arg

    }

}

#----------------------------------------------------------------------

# PublicMethods:

#----------------------------------------------------------------------

# method: add

#

#    Adds a new pane into the PanedWindow.

#

# options -size -max -min -allowresize

#

proc tixPanedWindow:add {w name args} {

    upvar #0 $w data

    if {[winfo exists $w.$name] && !$data($name,forgotten)} {

	error "Pane $name is already managed"

    }

    # Step 1: Parse the options to get the children's size options

    # The default values

    #

    if {[info exists data($name,forgotten)]} {

	set option(-size)        $data($name,size)

	set option(-min)         $data($name,min)

	set option(-max)         $data($name,max)

	set option(-allowresize) $data($name,allowresize)

	set option(-expand)      $data($name,expand)

    } else {

	set option(-size)        0

	set option(-min)         0

	set option(-max)         100000

	set option(-allowresize) 1

	set option(-expand)      0

    }

    set option(-before)      ""

    set option(-after)       ""

    set option(-at)          ""

    set validOpts {-after -allowresize -at -before -expand -max -min -size}

    tixHandleOptions option $validOpts $args

    set data($name,size)        $option(-size)

    set data($name,rsize)       $option(-size)

    set data($name,min)         $option(-min)

    set data($name,max)         $option(-max)

    set data($name,allowresize) $option(-allowresize)

    set data($name,expand)      $option(-expand)

    set data($name,forgotten)   0

    if {$data($name,expand) < 0} {

	set data($name,expand) 0

    }

    # Step 2: Add the frame and the separator (if necessary)

    #

    if {![winfo exist $w.$name]} {

	# need to check because the frame may have been "forget'ten"

	#

	frame $w.$name -bd $data(-paneborderwidth) -relief $data(-panerelief)

    }

    if {$option(-at) != ""} {

	set at [tixGetInt $option(-at)]

	if {$at < 0} {

	    set at 0

	}

    } elseif {$option(-after) != ""} {

	set index [lsearch -exact $data(items) $option(-after)]

	if {$index == -1} {

	    error "Pane $option(-after) doesn't exists"

	} else {

	    set at [incr index]

	}

    } elseif {$option(-before) != ""} {

	set index [lsearch -exact $data(items) $option(-before)]

	if {$index == -1} {

	    error "Pane $option(-before) doesn't exists"

	}

	set at $index

    } else {

	set at end

    }

    set data(items) [linsert $data(items) $at $name]    

    incr data(nItems)

    if {$data(nItems) > 1} {

	tixPanedWindow:AddSeparator $w

    }

    set data(w:$name) $w.$name

    # Step 3: Add the new frame. Adjust the window later (do when idle)

    #

    tixManageGeometry $w.$name [list tixPanedWindow:ClientGeomProc $w]

    bind $w.$name <Configure> \

	[list tixPanedWindow:ClientGeomProc $w "" $w.$name]

    tixPanedWindow:RepackWhenIdle $w

    return $w.$name

}

proc tixPanedWindow:manage {w name args} {

    upvar #0 $w data

    if {![winfo exists $w.$name]} {

	error "Pane $name does not exist"

    }

    if {!$data($name,forgotten)} {

	error "Pane $name is already managed"

    }

    tixMapWindow $data(w:$name)

    eval tixPanedWindow:add $w [list $name] $args

}

proc tixPanedWindow:forget {w name} {

    upvar #0 $w data

    if {![winfo exists $w.$name]} {

	error "Pane $name does not exist"

    }

    if $data($name,forgotten) {

	# It has already been forgotten

	#

	return

    }

    set items ""

    foreach item $data(items) {

	if {$item != $name} {

	    lappend items $item

	}

    }

    set data(items) $items

    incr data(nItems) -1

    set i $data(nItems)

    if {$i > 0} {

	destroy $data(btn,$i)

	destroy $data(sep,$i)

	unset data(btn,$i)

	unset data(sep,$i)

    }

    set data($name,forgotten) 1

    tixUnmapWindow $w.$name

    tixPanedWindow:RepackWhenIdle $w

}

proc tixPanedWindow:delete {w name} {

    upvar #0 $w data

    if {![winfo exists $w.$name]} {

	error "Pane $name does not exist"

    }

    if {!$data($name,forgotten)} {

	set items ""

	foreach item $data(items) {

	    if {$item != $name} {

		lappend items $item

	    }

	}

	set data(items) $items

	incr data(nItems) -1

	set i $data(nItems)

	if {$i > 0} {

	    destroy $data(btn,$i)

	    destroy $data(sep,$i)

	    unset data(btn,$i)

	    unset data(sep,$i)

	}

    }

    unset data($name,allowresize)

    unset data($name,expand)

    unset data($name,forgotten)

    unset data($name,max)

    unset data($name,min)

    unset data($name,rsize)

    unset data($name,size)

    unset data(w:$name)

    destroy $w.$name

    tixPanedWindow:RepackWhenIdle $w

}

proc tixPanedWindow:paneconfigure {w name args} {

    upvar #0 $w data

    if {![info exists data($name,size)]} {

	error "pane \"$name\" does not exist in $w"

    }

    set len [llength $args]

    if {$len == 0} {

	set value [$data(w:$name) configure]

	lappend value [list -allowresize "" "" "" $data($name,allowresize)]

	lappend value [list -expand "" "" "" $data($name,expand)]

	lappend value [list -max "" "" "" $data($name,max)]

	lappend value [list -min "" "" "" $data($name,min)]

	lappend value [list -size "" "" "" $data($name,size)]

	return $value

    }

    if {$len == 1} {

	case [lindex $args 0] {

	    -allowresize {

		return [list -allowresize "" "" "" $data($name,allowresize)]

	    }

	    -expand {

		return [list -expand "" "" "" $data($name,expand)]

	    }

	    -min {

		return [list -min "" "" "" $data($name,min)]

	    }

	    -max {

		return [list -max "" "" "" $data($name,max)]

	    }

	    -size {

		return [list -size "" "" "" $data($name,size)]

	    }

	    default {

		return [$data(w:$name) configure [lindex $args 0]]

	    }

	}

    }

    # By default handle each of the options

    #

    set option(-allowresize) $data($name,allowresize)

    set option(-expand)      $data($name,expand)

    set option(-min)         $data($name,min)

    set option(-max)         $data($name,max)

    set option(-size)        $data($name,size)

    tixHandleOptions -nounknown option {-allowresize -expand -max -min -size} \

	$args

    #

    # the widget options

    set new_args ""

    foreach {flag value} $args {

	case $flag {

	    {-expand -min -max -allowresize -size} {

	    }

	    default {

		lappend new_args $flag

		lappend new_args $value

	    }

	}

    }

    if {[llength $new_args] >= 2} {

	eval $data(w:$name) configure $new_args

    }

    #

    # The add-on options

    set data($name,allowresize) $option(-allowresize)

    set data($name,expand)      $option(-expand)

    set data($name,max)         $option(-max)

    set data($name,min)         $option(-min)

    set data($name,rsize)       $option(-size)

    set data($name,size)        $option(-size)

    # 

    # Integrity check

    if {$data($name,expand) < 0} {

	set data($name,expand) 0

    }

    if {$data($name,size) < $data($name,min)} {

	set data($name,size) $data($name,min)

    }

    if {$data($name,size) > $data($name,max)} {

	set data($name,size) $data($name,max)

    }

    tixPanedWindow:RepackWhenIdle $w

    return ""

}

proc tixPanedWindow:panecget {w name option} {

    upvar #0 $w data

    if {![info exists data($name,size)]} {

	error "pane \"$name\" does not exist in $w"

    }

    case $option {

	{-min -max -allowresize -size} {

	    regsub \\\- $option "" option

	    return "$data($name,$option)"

	}

	default {

	    return [$data(w:$name) cget $option]

	}

    }

}

# return the name of all panes

proc tixPanedWindow:panes {w} {

    upvar #0 $w data

    return $data(items)

}

# set the size of a pane, specifying which direction it should

# grow/shrink

proc tixPanedWindow:setsize {w item size {direction next}} {

    upvar #0 $w data

    set posn [lsearch $data(items) $item]

    if {$posn == -1} {

	error "pane \"$item\" does not exist"

    }

    set diff [expr {$size - $data($item,size)}]

    if {$diff == 0} {

	return

    }

    if {$posn == 0 && $direction eq "prev"} {

	set direction next

    }

    if {$posn == $data(nItems)-1 && $direction eq "next"} {

	set direction prev

    }

    if {$data(-orientation) eq "vertical"} {

        set rx [winfo rooty $data(w:$item)]

    } else {

        set rx [winfo rootx $data(w:$item)]

    }

    if {$direction eq "prev"} {

	set rx [expr {$rx - $diff}]

    } elseif {$data(-orientation) eq "vertical"} {

	set rx [expr {$rx + [winfo height $data(w:$item)] + $diff}]

	incr posn

    } else {

	set rx [expr {$rx + [winfo width $data(w:$item)] + $diff}]

	incr posn

    }

    # Set up the panedwin in a proper state

    #

    tixPanedWindow:BtnDown $w $posn 1

    tixPanedWindow:BtnMove $w $posn $rx 1

    tixPanedWindow:BtnUp $w $posn 1

    return $data(items)

}

#----------------------------------------------------------------------

# PrivateMethods:

#----------------------------------------------------------------------

proc tixPanedWindow:AddSeparator {w} {

    global tcl_platform

    upvar #0 $w data

    set n [expr {$data(nItems)-1}]

    # CYGNUS: On Windows, use relief ridge and a thicker line.

    if {$tcl_platform(platform) eq "windows"} then {

      set relief "ridge"

      set thickness 4

    } else {

      set relief "sunken"

      set thickness 2

    }

    if {$data(-orientation) eq "vertical"} {

	set data(sep,$n) [frame $w.sep$n -relief $relief \

	    -bd 1 -height $thickness -width 10000 -bg $data(-separatorbg)]

    } else {

	set data(sep,$n) [frame $w.sep$n -relief $relief \

	    -bd 1 -width $thickness -height 10000 -bg $data(-separatorbg)]

    }

    set data(btn,$n) [frame $w.btn$n -relief raised \

	-bd 1 -width 9 -height 9 \

	-bg $data(-handlebg)]

    if {$data(-orientation) eq "vertical"} {

	set cursor sb_v_double_arrow

    } else {

	set cursor sb_h_double_arrow

    }

    $data(sep,$n) config -cursor $cursor

    $data(btn,$n) config -cursor $cursor

    foreach wid [list $data(btn,$n) $data(sep,$n)] {

	bind $wid \

	    <ButtonPress-1>   [list tixPanedWindow:BtnDown $w $n]

	bind $wid \

	    <ButtonRelease-1> [list tixPanedWindow:BtnUp   $w $n]

	bind $wid \

	    <Any-Enter>       [list tixPanedWindow:HighlightBtn $w $n]

	bind $wid \

	    <Any-Leave>       [list tixPanedWindow:DeHighlightBtn $w $n]

    }

    if {$data(-orientation) eq "vertical"} {

	bind  $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %Y]

    } else {

	bind  $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %X]

    }

    if {$data(-orientation) eq "vertical"} {

#	place $data(btn,$n) -relx 0.90 -y [expr "$data(totalsize)-5"]

#	place $data(sep,$n) -x 0 -y [expr "$data(totalsize)-1"] -relwidth 1

    } else {

#	place $data(btn,$n) -rely 0.90 -x [expr "$data(totalsize)-5"]

#	place $data(sep,$n) -y 0 -x [expr "$data(totalsize)-1"] -relheight 1

    }

}

proc tixPanedWindow:BtnDown {w item {fake 0}} {

    upvar #0 $w data

    if {$data(-orientation) eq "vertical"} {

	set spec -height

    } else {

	set spec -width

    }

    if {!$fake} {