source: trunk/BWidget-1.2.1/panedw.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 10.8 KB
Line 
1# ------------------------------------------------------------------------------
2#  panedw.tcl
3#  This file is part of Unifix BWidget Toolkit
4# ------------------------------------------------------------------------------
5#  Index of commands:
6#     - PanedWindow::create
7#     - PanedWindow::configure
8#     - PanedWindow::cget
9#     - PanedWindow::add
10#     - PanedWindow::getframe
11#     - PanedWindow::_destroy
12#     - PanedWindow::_beg_move_sash
13#     - PanedWindow::_move_sash
14#     - PanedWindow::_end_move_sash
15#     - PanedWindow::_realize
16# ------------------------------------------------------------------------------
17
18namespace eval PanedWindow {
19    namespace eval Pane {
20        Widget::declare PanedWindow::Pane {
21            {-minsize Int 0 0 {=0}}
22            {-weight  Int 1 0 {=0}}
23        }
24    }
25
26    Widget::declare PanedWindow {
27        {-side       Enum       top 1 {top left bottom right}}
28        {-width      Int        10  1 {=6 ""}}
29        {-pad        Int        4   1 {=0 ""}}
30        {-background TkResource ""  0 frame}
31        {-bg         Synonym    -background}
32    }
33
34    variable _panedw
35
36    proc ::PanedWindow { path args } { return [eval PanedWindow::create $path $args] }
37    proc use {} {}
38}
39
40
41
42# ------------------------------------------------------------------------------
43#  Command PanedWindow::create
44# ------------------------------------------------------------------------------
45proc PanedWindow::create { path args } {
46    variable _panedw
47
48    Widget::init PanedWindow $path $args
49
50    frame $path -background [Widget::getoption $path -background]
51    set _panedw($path,nbpanes) 0
52
53    bind $path <Configure> "PanedWindow::_realize $path %w %h"
54    bind $path <Destroy>   "PanedWindow::_destroy $path"
55
56    rename $path ::$path:cmd
57    proc ::$path { cmd args } "return \[eval PanedWindow::\$cmd $path \$args\]"
58
59    return $path
60}
61
62
63# ------------------------------------------------------------------------------
64#  Command PanedWindow::configure
65# ------------------------------------------------------------------------------
66proc PanedWindow::configure { path args } {
67    variable _panedw
68
69    set res [Widget::configure $path $args]
70
71    if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
72        $path:cmd configure -background $bg
73        $path.f0 configure -background $bg
74        for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
75            set frame $path.sash$i
76            $frame configure -background $bg
77            $frame.sep configure -background $bg
78            $frame.but configure -background $bg
79            $path.f$i configure -background $bg
80            $path.f$i.frame configure -background $bg
81        }
82    }
83    return $res
84}
85
86
87# ------------------------------------------------------------------------------
88#  Command PanedWindow::cget
89# ------------------------------------------------------------------------------
90proc PanedWindow::cget { path option } {
91    return [Widget::cget $path $option]
92}
93
94
95# ------------------------------------------------------------------------------
96#  Command PanedWindow::add
97# ------------------------------------------------------------------------------
98proc PanedWindow::add { path args } {
99    variable _panedw
100
101    set num $_panedw($path,nbpanes)
102    Widget::init PanedWindow::Pane $path.f$num $args
103    set bg [Widget::getoption $path -background]
104
105    set wbut  [Widget::getoption $path -width]
106    set pad   [Widget::getoption $path -pad]
107    set width [expr {$wbut+2*$pad}]
108    set side  [Widget::getoption $path -side]
109    if { $num > 0 } {
110        set frame [frame $path.sash$num -relief flat -bd 0 -highlightthickness 0 \
111                       -width $width -height $width -bg $bg]
112        set sep   [frame $frame.sep -bd 1 -relief raised -highlightthickness 0 -bg $bg]
113        set but   [frame $frame.but -bd 1 -relief raised -highlightthickness 0 -bg $bg \
114                       -width $wbut -height $wbut]
115        if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
116            place $sep -relx 0.5 -y 0 -width 2 -relheight 1.0 -anchor n
117            if { ![string compare $side "top"] } {
118                place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
119            } else {
120                place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] -anchor c
121            }
122            $but configure -cursor sb_h_double_arrow
123            grid $frame -column [expr 2*$num-1] -row 0 -sticky ns
124            grid columnconfigure $path [expr 2*$num-1] -weight 0
125        } else {
126            place $sep -x 0 -rely 0.5 -height 2 -relwidth 1.0 -anchor w
127            if { ![string compare $side "left"] } {
128                place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
129            } else {
130                place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] -anchor c
131            }
132            $but configure -cursor sb_v_double_arrow
133            grid $frame -row [expr 2*$num-1] -column 0 -sticky ew
134            grid rowconfigure $path [expr 2*$num-1] -weight 0
135        }
136        bind $but <ButtonPress-1> "PanedWindow::_beg_move_sash $path $num %X %Y"
137    } else {
138        if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
139            grid rowconfigure $path 0 -weight 1
140        } else {
141            grid columnconfigure $path 0 -weight 1
142        }
143    }
144
145    set pane [frame $path.f$num -bd 0 -relief flat -highlightthickness 0 -bg $bg]
146    set user [frame $path.f$num.frame  -bd 0 -relief flat -highlightthickness 0 -bg $bg]
147    if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
148        grid $pane -column [expr 2*$num] -row 0 -sticky nsew
149        grid columnconfigure $path [expr 2*$num] \
150            -weight  [Widget::getoption $path.f$num -weight]
151    } else {
152        grid $pane -row [expr 2*$num] -column 0 -sticky nsew
153        grid rowconfigure $path [expr 2*$num] \
154            -weight  [Widget::getoption $path.f$num -weight]
155    }
156    pack $user -fill both -expand yes
157    incr _panedw($path,nbpanes)
158
159    return $user
160}
161
162
163# ------------------------------------------------------------------------------
164#  Command PanedWindow::getframe
165# ------------------------------------------------------------------------------
166proc PanedWindow::getframe { path index } {
167    if { [winfo exists $path.f$index.frame] } {
168        return $path.f$index.frame
169    }
170}
171
172
173# ------------------------------------------------------------------------------
174#  Command PanedWindow::_destroy
175# ------------------------------------------------------------------------------
176proc PanedWindow::_destroy { path } {
177    variable _panedw
178
179    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
180        Widget::destroy $path.f$i
181    }
182    unset _panedw($path,nbpanes)
183    Widget::destroy $path
184    rename $path {}
185}
186   
187
188# ------------------------------------------------------------------------------
189#  Command PanedWindow::_beg_move_sash
190# ------------------------------------------------------------------------------
191proc PanedWindow::_beg_move_sash { path num x y } {
192    variable _panedw
193
194    set fprev $path.f[expr $num-1]
195    set fnext $path.f$num
196    set wsash [expr [Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]]
197
198    $path.sash$num.but configure -relief sunken
199    set top  [toplevel $path.sash -borderwidth 1 -relief raised]
200
201    set minszg [Widget::getoption $fprev -minsize]
202    set minszd [Widget::getoption $fnext -minsize]
203    set side   [Widget::getoption $path -side]
204
205    if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
206        $top configure -cursor sb_h_double_arrow
207        set h    [winfo height $path]
208        set yr   [winfo rooty $path.sash$num]
209        set xmin [expr $wsash/2+[winfo rootx $fprev]+$minszg]
210        set xmax [expr -$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd]
211        wm overrideredirect $top 1
212        wm geom $top "2x${h}+$x+$yr"
213
214        update idletasks
215        grab set $top
216        bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width"
217        bind $top <Motion>          "PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr"
218        _move_sash $top $xmin $xmax $x "+%d+$yr"
219    } else {
220        $top configure -cursor sb_v_double_arrow
221        set w    [winfo width $path]
222        set xr   [winfo rootx $path.sash$num]
223        set ymin [expr $wsash/2+[winfo rooty $fprev]+$minszg]
224        set ymax [expr -$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd]
225        wm overrideredirect $top 1
226        wm geom $top "${w}x2+$xr+$y"
227
228        update idletasks
229        grab set $top
230        bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $ymin $ymax %Y rooty height"
231        bind $top <Motion>          "PanedWindow::_move_sash $top $ymin $ymax %Y +$xr+%%d"
232        _move_sash $top $ymin $ymax $y "+$xr+%d"
233    }
234}
235
236
237# ------------------------------------------------------------------------------
238#  Command PanedWindow::_move_sash
239# ------------------------------------------------------------------------------
240proc PanedWindow::_move_sash { top min max v form } {
241
242    if { $v < $min } {
243        set v $min
244    } elseif { $v > $max } {
245        set v $max
246    }
247    wm geom $top [format $form $v]
248}
249
250
251# ------------------------------------------------------------------------------
252#  Command PanedWindow::_end_move_sash
253# ------------------------------------------------------------------------------
254proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
255    variable _panedw
256
257    destroy $top
258    if { $v < $min } {
259        set v $min
260    } elseif { $v > $max } {
261        set v $max
262    }
263    set fprev $path.f[expr $num-1]
264    set fnext $path.f$num
265
266    $path.sash$num.but configure -relief raised
267
268    set wsash [expr [Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]]
269    set dv    [expr $v-[winfo $rootv $path.sash$num]-$wsash/2]
270    set w1    [winfo $size $fprev]
271    set w2    [winfo $size $fnext]
272
273    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
274        if { $i == $num-1} {
275            $fprev configure -$size [expr [winfo $size $fprev]+$dv]
276        } elseif { $i == $num } {
277            $fnext configure -$size [expr [winfo $size $fnext]-$dv]
278        } else {
279            $path.f$i configure -$size [winfo $size $path.f$i]
280        }
281    }
282}
283
284
285# ------------------------------------------------------------------------------
286#  Command PanedWindow::_realize
287# ------------------------------------------------------------------------------
288proc PanedWindow::_realize { path width height } {
289    variable _panedw
290
291    set x    0
292    set y    0
293    set hc   [winfo reqheight $path]
294    set hmax 0
295    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
296        $path.f$i configure \
297            -width  [winfo reqwidth  $path.f$i.frame] \
298            -height [winfo reqheight $path.f$i.frame]
299        place $path.f$i.frame -x 0 -y 0 -relwidth 1 -relheight 1
300    }
301
302    bind $path <Configure> {}
303}
Note: See TracBrowser for help on using the repository browser.