1# ----------------------------------------------------------------------------
2#  scrollframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: scrollframe.tcl,v 1.11 2009/07/17 15:29:51 oehhar Exp $
5# ----------------------------------------------------------------------------
6#  Index of commands:
7#     - ScrollableFrame::create
8#     - ScrollableFrame::configure
9#     - ScrollableFrame::cget
10#     - ScrollableFrame::getframe
11#     - ScrollableFrame::see
12#     - ScrollableFrame::xview
13#     - ScrollableFrame::yview
14#     - ScrollableFrame::_resize
15# ----------------------------------------------------------------------------
16
17namespace eval ScrollableFrame {
18    Widget::define ScrollableFrame scrollframe
19
20    # If themed, there is no background and -bg option
21    if {[Widget::theme]} {
22        Widget::declare ScrollableFrame {
23            {-width             Int        0  0 {}}
24            {-height            Int        0  0 {}}
25            {-areawidth         Int        0  0 {}}
26            {-areaheight        Int        0  0 {}}
27            {-constrainedwidth  Boolean    0 0}
28            {-constrainedheight Boolean    0 0}
29            {-xscrollcommand    TkResource "" 0 canvas}
30            {-yscrollcommand    TkResource "" 0 canvas}
31            {-xscrollincrement  TkResource "" 0 canvas}
32            {-yscrollincrement  TkResource "" 0 canvas}
33        }
34    } else {
35        Widget::declare ScrollableFrame {
36            {-background        TkResource "" 0 frame}
37            {-width             Int        0  0 {}}
38            {-height            Int        0  0 {}}
39            {-areawidth         Int        0  0 {}}
40            {-areaheight        Int        0  0 {}}
41            {-constrainedwidth  Boolean    0 0}
42            {-constrainedheight Boolean    0 0}
43            {-xscrollcommand    TkResource "" 0 canvas}
44            {-yscrollcommand    TkResource "" 0 canvas}
45            {-xscrollincrement  TkResource "" 0 canvas}
46            {-yscrollincrement  TkResource "" 0 canvas}
47            {-bg                Synonym    -background}
48        }
49    }
50
51    Widget::addmap ScrollableFrame "" :cmd {
52        -width {} -height {}
53        -xscrollcommand {} -yscrollcommand {}
54        -xscrollincrement {} -yscrollincrement {}
55    }
56    if { ! [Widget::theme]} {
57        Widget::addmap ScrollableFrame "" .frame {-background {}}
58    }
59
60    variable _widget
61
62    bind BwScrollableFrame <Configure> [list ScrollableFrame::_resize %W]
63    bind BwScrollableFrame <Destroy>   [list Widget::destroy %W]
64}
65
66
67# ----------------------------------------------------------------------------
68#  Command ScrollableFrame::create
69# ----------------------------------------------------------------------------
70proc ScrollableFrame::create { path args } {
71    Widget::init ScrollableFrame $path $args
72
73    set canvas [eval [list canvas $path] [Widget::subcget $path :cmd] \
74                    -highlightthickness 0 -borderwidth 0 -relief flat]
75
76    if {[Widget::theme]} {
77	set frame [eval [list ttk::frame $path.frame] \
78		       [Widget::subcget $path .frame]]
79	set bg [ttk::style lookup TFrame -background]
80    } else {
81	set frame [eval [list frame $path.frame] \
82		       [Widget::subcget $path .frame] \
83		       -highlightthickness 0 -borderwidth 0 -relief flat]
84	set bg [$frame cget -background]
85    }
86    # Give canvas frame (or theme) background
87    $canvas configure -background $bg
88
89    $canvas create window 0 0 -anchor nw -window $frame -tags win \
90        -width  [Widget::cget $path -areawidth] \
91        -height [Widget::cget $path -areaheight]
92
93    bind $frame <Configure> \
94        [list ScrollableFrame::_frameConfigure $canvas]
95    # add <unmap> binding: <configure> is not called when frame
96    # becomes so small that it suddenly falls outside of currently visible area.
97    # but now we need to add a <map> binding too
98    bind $frame <Map> \
99        [list ScrollableFrame::_frameConfigure $canvas]
100
101    # Tk 8.7/TIP518 allows to get an event when the last child is removed.
102    # In this case, we should resize to 1x1 pixel.
103    bind $frame <<NoManagedChild>>\
104            [list ScrollableFrame::_frameNoManagedChild $frame]
105
106    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]
107
108    return [Widget::create ScrollableFrame $path]
109}
110
111
112# ----------------------------------------------------------------------------
113#  Command ScrollableFrame::configure
114# ----------------------------------------------------------------------------
115proc ScrollableFrame::configure { path args } {
116    set res [Widget::configure $path $args]
117    set upd 0
118
119    set modcw [Widget::hasChanged $path -constrainedwidth cw]
120    set modw  [Widget::hasChanged $path -areawidth w]
121    if { $modcw || (!$cw && $modw) } {
122        set upd 1
123    }
124    if { $cw } {
125        set w [winfo width $path]
126    }
127
128    set modch [Widget::hasChanged $path -constrainedheight ch]
129    set modh  [Widget::hasChanged $path -areaheight h]
130    if { $modch || (!$ch && $modh) } {
131        set upd 1
132    }
133    if { $ch } {
134        set h [winfo height $path]
135    }
136
137    if { $upd } {
138        $path:cmd itemconfigure win -width $w -height $h
139    }
140    return $res
141}
142
143
144# ----------------------------------------------------------------------------
145#  Command ScrollableFrame::cget
146# ----------------------------------------------------------------------------
147proc ScrollableFrame::cget { path option } {
148    return [Widget::cget $path $option]
149}
150
151
152# ----------------------------------------------------------------------------
153#  Command ScrollableFrame::getframe
154# ----------------------------------------------------------------------------
155proc ScrollableFrame::getframe { path } {
156    return $path.frame
157}
158
159# ----------------------------------------------------------------------------
160#  Command ScrollableFrame::see
161# ----------------------------------------------------------------------------
162proc ScrollableFrame::see { path widget {vert top} {horz left} {xOffset 0} {yOffset 0}} {
163    set x0  [winfo x $widget]
164    set y0  [winfo y $widget]
165    set x1  [expr {$x0+[winfo width  $widget]}]
166    set y1  [expr {$y0+[winfo height $widget]}]
167    set xb0 [$path:cmd canvasx 0]
168    set yb0 [$path:cmd canvasy 0]
169    set xb1 [$path:cmd canvasx [winfo width  $path]]
170    set yb1 [$path:cmd canvasy [winfo height $path]]
171    set dx  0
172    set dy  0
173
174    if { [string equal $horz "left"] } {
175	if { $x1 > $xb1 } {
176	    set dx [expr {$x1-$xb1}]
177	}
178	if { $x0 < $xb0+$dx } {
179	    set dx [expr {$x0-$xb0}]
180	}
181    } elseif { [string equal $horz "right"] } {
182	if { $x0 < $xb0 } {
183	    set dx [expr {$x0-$xb0}]
184	}
185	if { $x1 > $xb1+$dx } {
186	    set dx [expr {$x1-$xb1}]
187	}
188    }
189
190    if { [string equal $vert "top"] } {
191	if { $y1 > $yb1 } {
192	    set dy [expr {$y1-$yb1}]
193	}
194	if { $y0 < $yb0+$dy } {
195	    set dy [expr {$y0-$yb0}]
196	}
197    } elseif { [string equal $vert "bottom"] } {
198	if { $y0 < $yb0 } {
199	    set dy [expr {$y0-$yb0}]
200	}
201	if { $y1 > $yb1+$dy } {
202	    set dy [expr {$y1-$yb1}]
203	}
204    }
205
206    if {($dx + $xOffset) != 0} {
207	set x [expr {($xb0+$dx+$xOffset)/[winfo width $path.frame]}]
208	$path:cmd xview moveto $x
209    }
210    if {($dy + $yOffset) != 0} {
211	set y [expr {($yb0+$dy+$yOffset)/[winfo height $path.frame]}]
212	$path:cmd yview moveto $y
213    }
214}
215
216
217# ----------------------------------------------------------------------------
218#  Command ScrollableFrame::xview
219# ----------------------------------------------------------------------------
220proc ScrollableFrame::xview { path args } {
221    return [eval [list $path:cmd xview] $args]
222}
223
224
225# ----------------------------------------------------------------------------
226#  Command ScrollableFrame::yview
227# ----------------------------------------------------------------------------
228proc ScrollableFrame::yview { path args } {
229    return [eval [list $path:cmd yview] $args]
230}
231
232
233# ----------------------------------------------------------------------------
234#  Command ScrollableFrame::_resize
235# ----------------------------------------------------------------------------
236proc ScrollableFrame::_resize { path } {
237    if { [Widget::getoption $path -constrainedwidth] } {
238        $path:cmd itemconfigure win -width [winfo width $path]
239    }
240    if { [Widget::getoption $path -constrainedheight] } {
241        $path:cmd itemconfigure win -height [winfo height $path]
242    }
243    # scollregion must also be reset when canvas size changes
244    _frameConfigure $path
245}
246
247
248# ----------------------------------------------------------------------------
249#  Command ScrollableFrame::_frameConfigure
250# ----------------------------------------------------------------------------
251proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]}
252proc ScrollableFrame::_frameConfigure {canvas} {
253    # This ensures that we don't get funny scrollability in the frame
254    # when it is smaller than the canvas space
255    # use [winfo] to get height & width of frame
256    if {![winfo ismapped $canvas.frame]} { return }
257    set height [_max [winfo height $canvas.frame] [winfo height $canvas]]
258    set width  [_max [winfo width  $canvas.frame] [winfo width  $canvas]]
259
260    $canvas:cmd configure -scrollregion [list 0 0 $width $height]
261}
262
263
264# ----------------------------------------------------------------------------
265#  Command ScrollableFrame::_frameNoManagedChild
266# ----------------------------------------------------------------------------
267proc ScrollableFrame::_frameNoManagedChild {frame} {
268    # There are no childs mapped any more, so resize frame to 1x1
269    $frame configure -width 1 -height 1
270    # Do not fix size, so set values to 0
271    $frame configure -width 0 -height 0
272}
273