b3da4421d8
Added colored icon for main window Fixed "Close all" procedure if opened files from projects and file browser
103 lines
3.1 KiB
Tcl
103 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]
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|