Attachment "panedw.tcl" to
ticket [435471ffff]
added by
nobody
2001-06-22 21:34:55.
# ------------------------------------------------------------------------------
# panedw.tcl
# This file is part of Unifix BWidget Toolkit
# ------------------------------------------------------------------------------
# Index of commands:
# - PanedWindow::create
# - PanedWindow::configure
# - PanedWindow::cget
# - PanedWindow::add
# - PanedWindow::getframe
# - PanedWindow::_destroy
# - PanedWindow::_beg_move_sash
# - PanedWindow::_move_sash
# - PanedWindow::_end_move_sash
# ------------------------------------------------------------------------------
namespace eval PanedWindow {
namespace eval Pane {
Widget::declare PanedWindow::Pane {
{-minsize Int 0 0 "%d >= 0"}
{-weight Int 1 0 "%d >= 0"}
}
}
Widget::declare PanedWindow {
{-side Enum top 1 {top left bottom right}}
{-width Int 10 1 "%d >=6"}
{-pad Int 4 1 "%d >= 0"}
{-background TkResource "" 0 frame}
{-bg Synonym -background}
}
variable _panedw
proc ::PanedWindow { path args } { return [eval PanedWindow::create $path $args] }
proc use {} {}
}
# ------------------------------------------------------------------------------
# Command PanedWindow::create
# ------------------------------------------------------------------------------
proc PanedWindow::create { path args } {
variable _panedw
Widget::init PanedWindow $path $args
frame $path -background [Widget::cget $path -background] -class PanedWindow
set _panedw($path,nbpanes) 0
bind $path <Destroy> "PanedWindow::_destroy $path"
rename $path ::$path:cmd
proc ::$path { cmd args } "return \[eval PanedWindow::\$cmd $path \$args\]"
return $path
}
# ------------------------------------------------------------------------------
# Command PanedWindow::configure
# ------------------------------------------------------------------------------
proc PanedWindow::configure { path args } {
variable _panedw
set res [Widget::configure $path $args]
if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
$path:cmd configure -background $bg
$path.f0 configure -background $bg
for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
set frame $path.sash$i
$frame configure -background $bg
$frame.sep configure -background $bg
if { [string compare $::tcl_platform(platform) "windows"] } {
$frame.but configure -background $bg
}
$path.f$i configure -background $bg
$path.f$i.frame configure -background $bg
}
}
return $res
}
# ------------------------------------------------------------------------------
# Command PanedWindow::cget
# ------------------------------------------------------------------------------
proc PanedWindow::cget { path option } {
return [Widget::cget $path $option]
}
# ------------------------------------------------------------------------------
# Command PanedWindow::add
# ------------------------------------------------------------------------------
proc PanedWindow::add { path args } {
variable _panedw
set num $_panedw($path,nbpanes)
Widget::init PanedWindow::Pane $path.f$num $args
set bg [Widget::getoption $path -background]
set wbut [Widget::getoption $path -width]
set pad [Widget::getoption $path -pad]
set width [expr {$wbut+2*$pad}]
set side [Widget::getoption $path -side]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
set size width
} else {
set size height
}
set rp 0.0
set trs [expr {0.0 + [Widget::getoption $path.f$num -weight]}]
# Re-'place' old frames and old sashes
if { $num > 0 } {
for { set i 0 } { $i < $num } { incr i } {
place forget $path.f$i
if { $i > 0 } {
place forget $path.sash$i
}
set trs [expr {$trs + [Widget::getoption $path.f$i -weight]}]
}
set as [winfo $size $path]
set rn $num.0
for { set i 0 } { $i < $num } { incr i } {
set rs [expr {[Widget::getoption $path.f$i -weight] / $trs}]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
place $path.f$i -relx $rp -rely 0.0 -anchor nw -relwidth $rs -relheight 1.0 -width -$width
} else {
place $path.f$i -relx 0.0 -rely $rp -anchor nw -relwidth 1.0 -relheight $rs -height -$width
}
if { $i > 0 } {
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
place $path.sash$i -relx $rp -x -$width -rely 0.0 -anchor nw -relheight 1.0 -width $width
} else {
place $path.sash$i -relx 0.0 -rely $rp -y -$width -anchor nw -relwidth 1.0 -height $width
}
}
set rp [expr {$rp + $rs}]
}
}
# Add new sash
if { $num > 0 } {
set frame [frame $path.sash$num -relief flat -bd 0 -highlightthickness 0 -width $width -height $width -bg $bg]
set sep [frame $frame.sep -bd 1 -relief raised -highlightthickness 0 -bg $bg]
if { [string compare $::tcl_platform(platform) "windows"] } {
set sep_width 2
} else {
set sep_width 5
}
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
place $frame -relx $rp -x -$width -rely 0.0 -anchor nw -relheight 1.0 -width $width
place $sep -relx 0.5 -y 0 -width $sep_width -relheight 1.0 -anchor n
$sep configure -cursor sb_h_double_arrow
} else {
place $frame -relx 0.0 -rely $rp -y -$width -anchor nw -relwidth 1.0 -height $width
place $sep -x 0 -rely 0.5 -height $sep_width -relwidth 1.0 -anchor w
$sep configure -cursor sb_v_double_arrow
}
bind $sep <ButtonPress-1> "PanedWindow::_beg_move_sash $path $num %X %Y"
if { [string compare $::tcl_platform(platform) "windows"] } {
set but [frame $frame.but -bd 1 -relief raised -highlightthickness 0 -bg $bg -width $wbut -height $wbut]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
if { ![string compare $side "top"] } {
place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
} else {
place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] -anchor c
}
$but configure -cursor sb_h_double_arrow
} else {
if { ![string compare $side "left"] } {
place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
} else {
place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] -anchor c
}
$but configure -cursor sb_v_double_arrow
}
bind $but <ButtonPress-1> "PanedWindow::_beg_move_sash $path $num %X %Y"
}
}
# Add new frame
set pane [frame $path.f$num -bd 0 -relief flat -highlightthickness 0 -bg $bg]
set user [frame $path.f$num.frame -bd 0 -relief flat -highlightthickness 0 -bg $bg]
set rs [expr {[Widget::getoption $path.f$num -weight] / $trs}]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
place $pane -relx $rp -rely 0.0 -anchor nw -relwidth $rs -relheight 1.0
} else {
place $pane -relx 0.0 -rely $rp -anchor nw -relwidth 1.0 -relheight $rs
}
pack $user -fill both -expand yes
incr _panedw($path,nbpanes)
return $user
}
# ------------------------------------------------------------------------------
# Command PanedWindow::getframe
# ------------------------------------------------------------------------------
proc PanedWindow::getframe { path index } {
if { [winfo exists $path.f$index.frame] } {
return $path.f$index.frame
}
}
# ------------------------------------------------------------------------------
# Command PanedWindow::_destroy
# ------------------------------------------------------------------------------
proc PanedWindow::_destroy { path } {
variable _panedw
for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
Widget::destroy $path.f$i
}
unset _panedw($path,nbpanes)
Widget::destroy $path
rename $path {}
}
# ------------------------------------------------------------------------------
# Command PanedWindow::_beg_move_sash
# ------------------------------------------------------------------------------
proc PanedWindow::_beg_move_sash { path num x y } {
variable _panedw
set fprev $path.f[expr {$num-1}]
set fnext $path.f$num
set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
if { [string compare $::tcl_platform(platform) "windows"] } {
$path.sash$num.but configure -relief sunken
}
set top [toplevel $path.sash -borderwidth 1 -relief raised]
set minszg [Widget::getoption $fprev -minsize]
set minszd [Widget::getoption $fnext -minsize]
set side [Widget::getoption $path -side]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
$top configure -cursor sb_h_double_arrow
set h [winfo height $path]
set yr [winfo rooty $path.sash$num]
set xmin [expr {$wsash/2+[winfo rootx $fprev]+$minszg}]
set xmax [expr {-$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd}]
wm overrideredirect $top 1
wm geom $top "2x${h}+$x+$yr"
update idletasks
grab set $top
bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width"
bind $top <Motion> "PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr"
_move_sash $top $xmin $xmax $x "+%d+$yr"
} else {
$top configure -cursor sb_v_double_arrow
set w [winfo width $path]
set xr [winfo rootx $path.sash$num]
set ymin [expr {$wsash/2+[winfo rooty $fprev]+$minszg}]
set ymax [expr {-$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd}]
wm overrideredirect $top 1
wm geom $top "${w}x2+$xr+$y"
update idletasks
grab set $top
bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $ymin $ymax %Y rooty height"
bind $top <Motion> "PanedWindow::_move_sash $top $ymin $ymax %Y +$xr+%%d"
_move_sash $top $ymin $ymax $y "+$xr+%d"
}
}
# ------------------------------------------------------------------------------
# Command PanedWindow::_move_sash
# ------------------------------------------------------------------------------
proc PanedWindow::_move_sash { top min max v form } {
if { $v < $min } {
set v $min
} elseif { $v > $max } {
set v $max
}
wm geom $top [format $form $v]
}
# ------------------------------------------------------------------------------
# Command PanedWindow::_end_move_sash
# ------------------------------------------------------------------------------
proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
variable _panedw
destroy $top
if { $v < $min } {
set v $min
} elseif { $v > $max } {
set v $max
}
set fprev $path.f[expr {$num-1}]
set fnext $path.f$num
set sash $path.sash$num
if { [string compare $::tcl_platform(platform) "windows"] } {
$sash.but configure -relief raised
}
set side [Widget::getoption $path -side]
set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
set dv [expr {$v-[winfo $rootv $sash]-$wsash/2}].0
set w [winfo $size $path].0
set rdv [expr {$dv / $w}]
set lprev [place info $fprev]
set lnext [place info $fnext]
set lsash [place info $sash]
if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
set rpprev [lindex $lprev [expr {[lsearch -exact $lprev -relx] + 1}]]
set rsprev [lindex $lprev [expr {[lsearch -exact $lprev -relwidth] + 1}]]
set rpnext [lindex $lnext [expr {[lsearch -exact $lnext -relx] + 1}]]
set rsnext [lindex $lnext [expr {[lsearch -exact $lnext -relwidth] + 1}]]
set rpsash [lindex $lsash [expr {[lsearch -exact $lsash -relx] + 1}]]
set nrpprev $rpprev
set nrsprev [expr {$rsprev + $rdv}]
set nrpnext [expr {$rpnext + $rdv}]
set nrsnext [expr {$rsnext - $rdv}]
set nrpsash [expr {$rpsash + $rdv}]
place $fprev -relx $nrpprev -rely 0.0 -anchor nw -relwidth $nrsprev -relheight 1.0 -width -$wsash
if { [expr {$num+1}] == $_panedw($path,nbpanes) } {
place $fnext -relx $nrpnext -rely 0.0 -anchor nw -relwidth $nrsnext -relheight 1.0
} else {
place $fnext -relx $nrpnext -rely 0.0 -anchor nw -relwidth $nrsnext -relheight 1.0 -width -$wsash
}
place $sash -relx $nrpsash -rely 0.0 -anchor nw -x -$wsash -relheight 1.0 -width $wsash
} else {
set rpprev [lindex $lprev [expr {[lsearch -exact $lprev -rely] + 1}]]
set rsprev [lindex $lprev [expr {[lsearch -exact $lprev -relheight] + 1}]]
set rpnext [lindex $lnext [expr {[lsearch -exact $lnext -rely] + 1}]]
set rsnext [lindex $lnext [expr {[lsearch -exact $lnext -relheight] + 1}]]
set rpsash [lindex $lsash [expr {[lsearch -exact $lsash -rely] + 1}]]
set nrpprev $rpprev
set nrsprev [expr {$rsprev + $rdv}]
set nrpnext [expr {$rpnext + $rdv}]
set nrsnext [expr {$rsnext - $rdv}]
set nrpsash [expr {$rpsash + $rdv}]
place $fprev -relx 0.0 -rely $nrpprev -anchor nw -relwidth 1.0 -relheight $nrsprev -height -$wsash
if { [expr {$num+1}] == $_panedw($path,nbpanes) } {
place $fnext -relx 0.0 -rely $nrpnext -anchor nw -relwidth 1.0 -relheight $nrsnext
} else {
place $fnext -relx 0.0 -rely $nrpnext -anchor nw -relwidth 1.0 -relheight $nrsnext -height -$wsash
}
place $sash -relx 0.0 -rely $nrpsash -y -$wsash -anchor nw -relwidth 1.0 -height $wsash
}
}
