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