projman/lib/pane.tcl
Sergey Kalinin a64b6b0e9a Added gray theme
Fixed work with file from directory but not project.
2018-02-13 13:23:40 +03:00

102 lines
3.1 KiB
Tcl

package provide pane 1.0
namespace eval pane {
namespace export create
proc create { f1 f2 args } {
global editor
set t(-orient) vertical
set t(-percent) 0.25
set t(-gripcolor) $editor(bg)
set t(-gripposition) 0.95
set t(-gripcursor) crosshair
set t(-in) [winfo parent $f1]
array set t $args
set master $t(-in)
upvar #0 [namespace current]::Pane$master pane
array set pane [array get t]
if {! [string match v* $pane(-orient)] } {
set pane(-gripcursor) sb_v_double_arrow
set height 5 ; set width 3000
} else {
set pane(-gripcursor) sb_h_double_arrow
set height 3000 ; set width 5
}
set pane(1) $f1
set pane(2) $f2
set pane(grip) [frame $master.grip -background $pane(-gripcolor) \
-width $width -height $height \
-bd 1 -relief raised -cursor $pane(-gripcursor)]
if {! [string match v* $pane(-orient)] } {
set pane(D) Y
place $pane(1) -in $master -x 0 -rely 0.0 -anchor nw -relwidth 1.0 -height -1
place $pane(2) -in $master -x 0 -rely 1.0 -anchor sw -relwidth 1.0 -height -1
place $pane(grip) -in $master -anchor c -relx $pane(-gripposition)
} else {
set pane(D) X
place $pane(1) -in $master -relx 0.0 -y 0 -anchor nw -relheight 1.0 -width -1
place $pane(2) -in $master -relx 1.0 -y 0 -anchor ne -relheight 1.0 -width -1
place $pane(grip) -in $master -anchor c -rely 0 ;#$pane(-gripposition)
}
$master configure -background gray50
bind $master <Configure> [list [namespace current]::PaneGeometry $master]
bind $pane(grip) <ButtonPress-1> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <B1-Motion> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <ButtonRelease-1> \
[list [namespace current]::PaneStop $master]
[namespace current]::PaneGeometry $master
}
proc PaneDrag { master D } {
upvar #0 [namespace current]::Pane$master pane
if {[info exists pane(lastD)]} {
set delta [expr double($pane(lastD) - $D) \
/ $pane(size)]
set pane(-percent) [expr $pane(-percent) - $delta]
if {$pane(-percent) < 0.0} {
set pane(-percent) 0.0
} elseif {$pane(-percent) > 1.0} {
set pane(-percent) 1.0
}
[namespace current]::PaneGeometry $master
}
set pane(lastD) $D
}
proc PaneStop { master } {
upvar #0 [namespace current]::Pane$master pane
catch {unset pane(lastD)}
}
proc PaneGeometry { master } {
upvar #0 [namespace current]::Pane$master pane
if {$pane(D) == "X"} {
place $pane(1) -relwidth $pane(-percent)
place $pane(2) -relwidth [expr 1.0 - $pane(-percent)]
place $pane(grip) -relx $pane(-percent)
set pane(size) [winfo width $master]
} else {
place $pane(1) -relheight $pane(-percent)
place $pane(2) -relheight [expr 1.0 - $pane(-percent)]
place $pane(grip) -rely $pane(-percent)
set pane(size) [winfo height $master]
}
}
}