0x2620/openmedialibrary_platform_win32
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity
openmedialibrary_platform_w.../tcl/tix8.4.3/PanedWin.tcl

1216 lines
28 KiB
Tcl
Raw Normal View History

update windows build to Python 3.7
2019-01-20 10:35:31 +00:00
# -*- 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} {
for {set i 1} {$i < $data(nItems)} {incr i} {
$data(sep,$i) config -bg $data(-separatoractivebg) $spec 1
}
update idletasks
$data(btn,$item) config -relief sunken
}
tixPanedWindow:GetMotionLimit $w $item $fake
if {!$fake} {
grab -global $data(btn,$item)
}
set data(movePending) 0
}
proc tixPanedWindow:Min2 {a b} {
if {$a < $b} {
return $a
} else {
return $b
}
}
proc tixPanedWindow:GetMotionLimit {w item fake} {
upvar #0 $w data
set curBefore 0
set minBefore 0
set maxBefore 0
for {set i 0} {$i < $item} {incr i} {
set name [lindex $data(items) $i]
incr curBefore $data($name,size)
incr minBefore $data($name,min)
incr maxBefore $data($name,max)
}
set curAfter 0
set minAfter 0
set maxAfter 0
while {$i < $data(nItems)} {
set name [lindex $data(items) $i]
incr curAfter $data($name,size)
incr minAfter $data($name,min)
incr maxAfter $data($name,max)
incr i
}
set beforeToGo [tixPanedWindow:Min2 \
[expr {$curBefore-$minBefore}] \
[expr {$maxAfter-$curAfter}]]
set afterToGo [tixPanedWindow:Min2 \
[expr {$curAfter-$minAfter}] \
[expr {$maxBefore-$curBefore}]]
set data(beforeLimit) [expr {$curBefore-$beforeToGo}]
set data(afterLimit) [expr {$curBefore+$afterToGo}]
set data(curSize) $curBefore
if {!$fake} {
tixPanedWindow:PlotHandles $w 1
}
}
# Compress the motion so that update is quick even on slow machines
#
# rootp = root position (either rootx or rooty)
proc tixPanedWindow:BtnMove {w item rootp {fake 0}} {
upvar #0 $w data
set data(rootp) $rootp
if {$fake} {
tixPanedWindow:BtnMoveCompressed $w $item $fake
} else {
if {$data(movePending) == 0} {
after 2 tixPanedWindow:BtnMoveCompressed $w $item
set data(movePending) 1
}
}
}
proc tixPanedWindow:BtnMoveCompressed {w item {fake 0}} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
if {$data(-orientation) eq "vertical"} {
set p [expr {$data(rootp)-[winfo rooty $w]}]
} else {
set p [expr {$data(rootp)-[winfo rootx $w]}]
}
if {$p == $data(curSize)} {
set data(movePending) 0
return
}
if {$p < $data(beforeLimit)} {
set p $data(beforeLimit)
}
if {$p >= $data(afterLimit)} {
set p $data(afterLimit)
}
tixPanedWindow:CalculateChange $w $item $p $fake
if {!$fake} {
# Force the redraw to happen
#
update idletasks
}
set data(movePending) 0
}
# Calculate the change in response to mouse motions
#
proc tixPanedWindow:CalculateChange {w item p {fake 0}} {
upvar #0 $w data
if {$p < $data(curSize)} {
tixPanedWindow:MoveBefore $w $item $p
} elseif {$p > $data(curSize)} {
tixPanedWindow:MoveAfter $w $item $p
}
if {!$fake} {
tixPanedWindow:PlotHandles $w 1
}
}
proc tixPanedWindow:MoveBefore {w item p} {
upvar #0 $w data
set n [expr {$data(curSize)-$p}]
# Shrink the frames before
#
set from [expr {$item-1}]
set to 0
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
# Adjust the frames after
#
set from $item
set to [expr {$data(nItems)-1}]
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
set data(curSize) $p
}
proc tixPanedWindow:MoveAfter {w item p} {
upvar #0 $w data
set n [expr {$p-$data(curSize)}]
# Shrink the frames after
#
set from $item
set to [expr {$data(nItems)-1}]
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
# Graw the frame before
#
set from [expr {$item-1}]
set to 0
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
set data(curSize) $p
}
proc tixPanedWindow:CancleLines {w} {
upvar #0 $w data
if {[info exists data(lines)]} {
foreach line $data(lines) {
set x1 [lindex $line 0]
set y1 [lindex $line 1]
set x2 [lindex $line 2]
set y2 [lindex $line 3]
tixTmpLine $x1 $y1 $x2 $y2 $w
}
catch {unset data(lines)}
}
}
proc tixPanedWindow:PlotHandles {w transient} {
global tcl_platform
upvar #0 $w data
set totalsize 0
set i 0
if {$data(-orientation) eq "vertical"} {
set btnp [expr {[winfo width $w]-13}]
} else {
set h [winfo height $w]
if {$h > 18} {
set btnp 9
} else {
set btnp [expr {$h-9}]
}
}
set firstpane [lindex $data(items) 0]
set totalsize $data($firstpane,size)
if {$transient} {
tixPanedWindow:CancleLines $w
set data(lines) ""
}
for {set i 1} {$i < $data(nItems)} {incr i} {
if {! $transient} {
if {$data(-orientation) eq "vertical"} {
place $data(btn,$i) -x $btnp -y [expr {$totalsize-4}]
place $data(sep,$i) -x 0 -y [expr {$totalsize-1}] -relwidth 1
} else {
place $data(btn,$i) -y $btnp -x [expr {$totalsize-5}]
place $data(sep,$i) -y 0 -x [expr {$totalsize-1}] -relheight 1
}
} else {
if {$data(-orientation) eq "vertical"} {
set x1 [winfo rootx $w]
set x2 [expr {$x1 + [winfo width $w]}]
set y [expr {$totalsize-1+[winfo rooty $w]}]
tixTmpLine $x1 $y $x2 $y $w
lappend data(lines) [list $x1 $y $x2 $y]
} else {
set y1 [winfo rooty $w]
set y2 [expr {$y1 + [winfo height $w]}]
set x [expr {$totalsize-1+[winfo rootx $w]}]
tixTmpLine $x $y1 $x $y2 $w
lappend data(lines) [list $x $y1 $x $y2]
}
}
set name [lindex $data(items) $i]
incr totalsize $data($name,size)
}
}
proc tixPanedWindow:BtnUp {w item {fake 0}} {
upvar #0 $w data
if {!$fake} {
tixPanedWindow:CancleLines $w
}
tixPanedWindow:UpdateSizes $w
if {!$fake} {
$data(btn,$item) config -relief raised
grab release $data(btn,$item)
}
}
proc tixPanedWindow:HighlightBtn {w item} {
upvar #0 $w data
$data(btn,$item) config -background $data(-handleactivebg)
}
proc tixPanedWindow:DeHighlightBtn {w item} {
upvar #0 $w data
$data(btn,$item) config -background $data(-handlebg)
}
#----------------------------------------------------------------------
#
#
# Geometry management routines
#
#
#----------------------------------------------------------------------
# update the sizes of each pane according to the data($name,size) variables
#
proc tixPanedWindow:UpdateSizes {w} {
global tcl_platform
upvar #0 $w data
set data(totalsize) 0
set mw [winfo width $w]
set mh [winfo height $w]
for {set i 0} {$i < $data(nItems)} {incr i} {
set name [lindex $data(items) $i]
if {$data($name,size) > 0} {
if {$data(-orientation) eq "vertical"} {
tixMoveResizeWindow $w.$name 0 $data(totalsize) \
$mw $data($name,size)
tixMapWindow $w.$name
raise $w.$name
} else {
tixMoveResizeWindow $w.$name $data(totalsize) 0 \
$data($name,size) $mh
tixMapWindow $w.$name
raise $w.$name
}
} else {
tixUnmapWindow $w.$name
}
incr data(totalsize) $data($name,size)
}
# Reset the color and width of the separator
#
if {$data(-orientation) eq "vertical"} {
set spec -height
} else {
set spec -width
}
# CYGNUS: On Windows, use a thicker line.
if {$tcl_platform(platform) eq "windows"} then {
set thickness 4
} else {
set thickness 2
}
for {set i 1} {$i < $data(nItems)} {incr i} {
$data(sep,$i) config -bg $data(-separatorbg) $spec $thickness
raise $data(sep,$i)
raise $data(btn,$i)
}
# Invoke the callback command
#
if {$data(-command) != ""} {
set sizes ""
foreach item $data(items) {
lappend sizes $data($item,size)
}
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind [list $sizes]
}
}
proc tixPanedWindow:GetNaturalSizes {w} {
upvar #0 $w data
set data(totalsize) 0
set totalreq 0
if {$data(-orientation) eq "vertical"} {
set majorspec height
set minorspec width
} else {
set majorspec width
set minorspec height
}
set minorsize 0
foreach name $data(items) {
if {[winfo manager $w.$name] ne "tixGeometry"} {
error "Geometry management error: pane \"$w.$name\" cannot be managed by \"[winfo manager $w.$name]\"\nhint: delete the line \"[winfo manager $w.$name] $w.$name ...\" from your program"
}
# set the minor size
#
set req_minor [winfo req$minorspec $w.$name]
if {$req_minor > $minorsize} {
set minorsize $req_minor
}
# Check the natural size against the max, min requirements.
# Change the natural size if necessary
#
if {$data($name,size) <= 1} {
set data($name,size) [winfo req$majorspec $w.$name]
}
if {$data($name,size) > 1} {
# If we get zero maybe the widget was not initialized yet ...
#
# %% hazard : what if the window is really 1x1?
#
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)
}
}
# kludge: because a frame always returns req size of {1,1} before
# the packer processes it, we do the following to mark the
# pane as "size unknown"
#
# if {$data($name,size) == 1 && ![winfo ismapped $w.$name]} {
# set data($name,size) 0
# }
# Add up the total size
#
incr data(totalsize) $data($name,size)
# Find out the request size
#
if {$data($name,rsize) == 0} {
set rsize [winfo req$majorspec $w.$name]
} else {
set rsize $data($name,rsize)
}
if {$rsize < $data($name,min)} {
set rsize $data($name,min)
}
if {$rsize > $data($name,max)} {
set rsize $data($name,max)
}
incr totalreq $rsize
}
if {$data(-orientation) eq "vertical"} {
return [list $minorsize $totalreq]
} else {
return [list $totalreq $minorsize]
}
}
#--------------------------------------------------
# Handling resize
#--------------------------------------------------
proc tixPanedWindow:ClientGeomProc {w type client} {
tixPanedWindow:RepackWhenIdle $w
}
#
# This monitor the sizes of the master window
#
proc tixPanedWindow:MasterGeomProc {w master} {
tixPanedWindow:RepackWhenIdle $w
}
proc tixPanedWindow:RepackWhenIdle {w} {
if {![winfo exist $w]} {
return
}
upvar #0 $w data
if {$data(repack) == 0} {
tixWidgetDoWhenIdle tixPanedWindow:Repack $w
set data(repack) 1
}
}
#
# This monitor the sizes of the master window
#
proc tixPanedWindow:Repack {w} {
upvar #0 $w data
# Calculate the desired size of the master
#
set dim [tixPanedWindow:GetNaturalSizes $w]
if {$data(-width) != 0} {
set mreqw $data(-width)
} else {
set mreqw [lindex $dim 0]
}
if {$data(-height) != 0} {
set mreqh $data(-height)
} else {
set mreqh [lindex $dim 1]
}
if !$data(-dynamicgeometry) {
if {$mreqw < $data(maxReqW)} {
set mreqw $data(maxReqW)
}
if {$mreqh < $data(maxReqH)} {
set mreqh $data(maxReqH)
}
set data(maxReqW) $mreqw
set data(maxReqH) $mreqh
}
if {$mreqw != [winfo reqwidth $w] || $mreqh != [winfo reqheight $w] } {
if {![info exists data(counter)]} {
set data(counter) 0
}
if {$data(counter) < 50} {
incr data(counter)
tixGeometryRequest $w $mreqw $mreqh
tixWidgetDoWhenIdle tixPanedWindow:Repack $w
set data(repack) 1
return
}
}
set data(counter) 0
if {$data(nItems) == 0} {
set data(repack) 0
return
}
tixWidgetDoWhenIdle tixPanedWindow:DoRepack $w
}
proc tixPanedWindow:DoRepack {w} {
upvar #0 $w data
if {$data(-orientation) eq "vertical"} {
set newSize [winfo height $w]
} else {
set newSize [winfo width $w]
}
if {$newSize <= 1} {
# Probably this window is too small to see anyway
# %%Kludge: I don't know if this always work.
#
set data(repack) 0
return
}
set totalExp 0
foreach name $data(items) {
set totalExp [expr {$totalExp + $data($name,expand)}]
}
if {$newSize > $data(totalsize)} {
# Grow
#
set toGrow [expr {$newSize-$data(totalsize)}]
set p [llength $data(items)]
foreach name $data(items) {
set toGrow [tixPanedWindow:xGrow $w $name $toGrow $totalExp $p]
if {$toGrow > 0} {
set totalExp [expr {$totalExp-$data($name,expand)}]
incr p -1
} else {
break
}
}
} else {
# Shrink
#
set toShrink [expr {$data(totalsize)-$newSize}]
set usedSize 0
foreach name $data(items) {
set toShrink [tixPanedWindow:xShrink $w $name $toShrink \
$totalExp $newSize $usedSize]
if {$toShrink > 0} {
set totalExp [expr {$totalExp-$data($name,expand)}]
incr usedSize $data($name,size)
} else {
break
}
}
}
tixPanedWindow:UpdateSizes $w
tixPanedWindow:PlotHandles $w 0
set data(repack) 0
}
#--------------------------------------------------
# Shrink and grow items
#--------------------------------------------------
#
# toGrow: how much free area to grow into
# p: == 1 if $name is the last in the list of items
# totalExp: used to calculate the amount of the free area that this
# window can grow into
#
proc tixPanedWindow:xGrow {w name toGrow totalExp p} {
upvar #0 $w data
if {$p == 1} {
set canGrow $toGrow
} else {
if {$totalExp == 0} {
set canGrow 0
} else {
set canGrow [expr {int($toGrow * $data($name,expand) / $totalExp)}]
}
}
if {($canGrow + $data($name,size)) > $data($name,max)} {
set canGrow [expr {$data($name,max) - $data($name,size)}]
}
incr data($name,size) $canGrow
incr toGrow -$canGrow
return $toGrow
}
proc tixPanedWindow:xShrink {w name toShrink totalExp newSize usedSize} {
upvar #0 $w data
if {$totalExp == 0} {
set canShrink 0
} else {
set canShrink [expr {int($toShrink * $data($name,expand) / $totalExp)}]
}
if {$data($name,size) - $canShrink < $data($name,min)} {
set canShrink [expr {$data($name,size) - $data($name,min)}]
}
if {$usedSize + $data($name,size) - $canShrink > $newSize} {
set data($name,size) [expr {$newSize - $usedSize}]
return 0
} else {
incr data($name,size) -$canShrink
incr toShrink -$canShrink
return $toShrink
}
}
#--------------------------------------------------
# Shrink and grow items
#--------------------------------------------------
proc tixPanedWindow:Shrink {w name n} {
upvar #0 $w data
set canShrink [expr {$data($name,size) - $data($name,min)}]
if {$canShrink > $n} {
incr data($name,size) -$n
return 0
} elseif {$canShrink > 0} {
set data($name,size) $data($name,min)
incr n -$canShrink
}
return $n
}
proc tixPanedWindow:Grow {w name n} {
upvar #0 $w data
set canGrow [expr {$data($name,max) - $data($name,size)}]
if {$canGrow > $n} {
incr data($name,size) $n
return 0
} elseif {$canGrow > 0} {
set data($name,size) $data($name,max)
incr n -$canGrow
}
return $n
}
proc tixPanedWindow:Iterate {w from to proc n} {
upvar #0 $w data
if {$from <= $to} {
for {set i $from} {$i <= $to} {incr i} {
set n [$proc $w [lindex $data(items) $i] $n]
if {$n == 0} {
break
}
}
} else {
for {set i $from} {$i >= $to} {incr i -1} {
set n [$proc $w [lindex $data(items) $i] $n]
if {$n == 0} {
break
}
}
}
}
Reference in a new issue Copy permalink