Bwidget Source Code
Check-in [d2b4cecf3d]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:-onlyhover not default. Removed dead code. Comments modified.
Timelines: family | ancestors | descendants | both | rfe-d5480d1da2
Files: files | file ages | folders
SHA1: d2b4cecf3d8b7789eab3808d47ccd2fb3f189b92
User & Date: oehhar 2017-01-14 13:07:39
Context
2017-01-14
13:22
Revert demo test modification check-in: cad07b0345 user: oehhar tags: rfe-d5480d1da2
13:07
-onlyhover not default. Removed dead code. Comments modified. check-in: d2b4cecf3d user: oehhar tags: rfe-d5480d1da2
2017-01-12
14:39
Display ScrolledWindow scrollbars only if mouse is in the widget. Tciket [d5480d1da2] by Alexandru check-in: 246eaca515 user: oehhar tags: rfe-d5480d1da2
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to demo/manager.tcl.

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
            $lb insert end "Value $i"
        }
        $sw setwidget $lb
        pack $sw -fill both -expand yes
    }

    set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
    set sf [ScrollableFrame $sw.f]
    $sw setwidget $sf
    set subf [$sf getframe]
    set lab [label $subf.lab -text "This is a ScrollableFrame"]
    set chk [checkbutton $subf.chk -text "Constrained width" \
                 -variable DemoManager::_constw \
                 -command  "$sf configure -constrainedwidth \$DemoManager::_constw"]
    pack $lab






|







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
            $lb insert end "Value $i"
        }
        $sw setwidget $lb
        pack $sw -fill both -expand yes
    }

    set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
    set sf [ScrollableFrame $sw.f -onlyhover 1]
    $sw setwidget $sf
    set subf [$sf getframe]
    set lab [label $subf.lab -text "This is a ScrollableFrame"]
    set chk [checkbutton $subf.chk -text "Constrained width" \
                 -variable DemoManager::_constw \
                 -command  "$sf configure -constrainedwidth \$DemoManager::_constw"]
    pack $lab

Changes to scrollframe.tcl.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
...
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
#     - ScrollableFrame::see
#     - ScrollableFrame::xview
#     - ScrollableFrame::yview
#     - ScrollableFrame::_resize
# ----------------------------------------------------------------------------

namespace eval ScrollableFrame {
    # This new global variable makes possible that the scrollbar is shown only when the mouse is over the frame
    array set mouseover {}

    Widget::define ScrollableFrame scrollframe

    # If themed, there is no background and -bg option
    if {[Widget::theme]} {
        Widget::declare ScrollableFrame {
            {-width             Int        0  0 {}}
            {-height            Int        0  0 {}}
            {-areawidth         Int        0  0 {}}
            {-areaheight        Int        0  0 {}}
            {-constrainedwidth  Boolean    0 0}
            {-constrainedheight Boolean    0 0}
            {-onlyhover         Boolean    1 1}
            {-xscrollcommand    TkResource "" 0 canvas}
            {-yscrollcommand    TkResource "" 0 canvas}
            {-xscrollincrement  TkResource "" 0 canvas}
            {-yscrollincrement  TkResource "" 0 canvas}
        }
    } else {
        Widget::declare ScrollableFrame {
................................................................................
            {-xscrollincrement  TkResource "" 0 canvas}
            {-yscrollincrement  TkResource "" 0 canvas}
            {-bg                Synonym    -background}
        }
    }

    Widget::addmap ScrollableFrame "" :cmd {
        -width {} -height {}
        -xscrollcommand {} -yscrollcommand {}
        -xscrollincrement {} -yscrollincrement {}
    }
    if { ! [Widget::theme]} {
        Widget::addmap ScrollableFrame "" .frame {-background {}}
    }

................................................................................
}


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::create
# ----------------------------------------------------------------------------
proc ScrollableFrame::create { path args } {
    # This new global variable makes possible that the scrollbar is shown only when the mouse is over the frame
    variable mouseover

    Widget::init ScrollableFrame $path $args

    # Actually $canvas is the same as $path
    set canvas [eval [list canvas $path] [Widget::subcget $path :cmd] \
                    -highlightthickness 0 -borderwidth 0 -relief flat]

    # Initialize it to 1 (mouse is over the frame)
    set mouseover($canvas) 1

    set onlyhover [Widget::cget $path -onlyhover]

    if {[Widget::theme]} {
	set frame [eval [list ttk::frame $path.frame] \
		       [Widget::subcget $path .frame]]
................................................................................
        [list ScrollableFrame::_frameConfigure $canvas]
    bind $frame <Unmap> \
        [list ScrollableFrame::_frameConfigure $canvas 1]

    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]

    if {$onlyhover} {
        # This makes possible that the scrollbar is shown only when the mouse is over the frame
        bind [winfo parent $path] <Enter> [list ScrollableFrame::enter $canvas]
        # This makes possible that the scrollbar is hidden only when the mouse is not over the frame
        bind [winfo parent $path] <Leave> [list ScrollableFrame::leave $canvas]
    }

    return [Widget::create ScrollableFrame $path]
}

# ----------------------------------------------------------------------------
#  Command ScrollableFrame::enter
# ----------------------------------------------------------------------------
# This makes possible that the scrollbar is shown only when the mouse is over the frame
proc ScrollableFrame::enter {canvas} {
    variable mouseover
    set mouseover($canvas) 1
    ScrollableFrame::_frameConfigure $canvas
}

# ----------------------------------------------------------------------------
#  Command ScrollableFrame::leave
# ----------------------------------------------------------------------------
# This makes possible that the scrollbar is hidden only when the mouse is not over the frame
proc ScrollableFrame::leave {canvas} {
    variable mouseover
    set mouseover($canvas) 0
    ScrollableFrame::_frameConfigure $canvas 1
}

# ----------------------------------------------------------------------------
................................................................................
    set y1  [expr {$y0+[winfo height $widget]}]
    set xb0 [$path:cmd canvasx 0]
    set yb0 [$path:cmd canvasy 0]
    set xb1 [$path:cmd canvasx [winfo width  $path]]
    set yb1 [$path:cmd canvasy [winfo height $path]]
    set dx  0
    set dy  0

    if { [string equal $horz "left"] } {
	if { $x1 > $xb1 } {
	    set dx [expr {$x1-$xb1}]
	}
	if { $x0 < $xb0+$dx } {
	    set dx [expr {$x0-$xb0}]
	}
................................................................................
}


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::_frameConfigure
# ----------------------------------------------------------------------------
proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]}
proc ScrollableFrame::_frameConfigure {canvas {unmap 0}} {
    variable mouseover
    # This makes possible that the scrollbar is hidden when the mouse is not over the frame
    if {$mouseover($canvas)==0} {
        set unmap 1
    }
    # This ensures that we don't get funny scrollability in the frame
    # when it is smaller than the canvas space
    # use [winfo] to get height & width of frame
    # [winfo] doesn't work for unmapped frame
    set frameh [expr {$unmap ? 0 : [winfo height $canvas.frame]}]
    set framew [expr {$unmap ? 0 : [winfo width  $canvas.frame]}]

    set height [_max $frameh [winfo height $canvas]]
    set width  [_max $framew [winfo width  $canvas]]

    $canvas:cmd configure -scrollregion [list 0 0 $width $height]
}
proc ::ScrollableFrame::_frameConfigure {canvas {unmap 0}} {
    variable mouseover
    # This makes possible that the scrollbar is hidden when the mouse is not over the frame
    if {$mouseover($canvas)==0} {
        set unmap 1
    }

    ## There is a bug in BWidget 1.9.0 related to the ScrollableFrame.
    # Described in https://groups.google.com/forum/#!topic/comp.lang.tcl/Q5prg9lsOYc
    # This added code solves the problem (see https://core.tcl.tk/bwidget/tktview/72a5727d1b7fb76b32cea032eb7d4bf7c6fa28bf)






|













|







 







|







 







<








|







 







|

|









|









|







 







|







 







|

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
...
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
...
281
282
283
284
285
286
287
288
289
290


















291
292
293
294
295
296
297
#     - ScrollableFrame::see
#     - ScrollableFrame::xview
#     - ScrollableFrame::yview
#     - ScrollableFrame::_resize
# ----------------------------------------------------------------------------

namespace eval ScrollableFrame {
    # track scrollbar on hoover
    array set mouseover {}

    Widget::define ScrollableFrame scrollframe

    # If themed, there is no background and -bg option
    if {[Widget::theme]} {
        Widget::declare ScrollableFrame {
            {-width             Int        0  0 {}}
            {-height            Int        0  0 {}}
            {-areawidth         Int        0  0 {}}
            {-areaheight        Int        0  0 {}}
            {-constrainedwidth  Boolean    0 0}
            {-constrainedheight Boolean    0 0}
            {-onlyhover         Boolean    0 0}
            {-xscrollcommand    TkResource "" 0 canvas}
            {-yscrollcommand    TkResource "" 0 canvas}
            {-xscrollincrement  TkResource "" 0 canvas}
            {-yscrollincrement  TkResource "" 0 canvas}
        }
    } else {
        Widget::declare ScrollableFrame {
................................................................................
            {-xscrollincrement  TkResource "" 0 canvas}
            {-yscrollincrement  TkResource "" 0 canvas}
            {-bg                Synonym    -background}
        }
    }

    Widget::addmap ScrollableFrame "" :cmd {
        -width {} -height {} 
        -xscrollcommand {} -yscrollcommand {}
        -xscrollincrement {} -yscrollincrement {}
    }
    if { ! [Widget::theme]} {
        Widget::addmap ScrollableFrame "" .frame {-background {}}
    }

................................................................................
}


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::create
# ----------------------------------------------------------------------------
proc ScrollableFrame::create { path args } {

    variable mouseover

    Widget::init ScrollableFrame $path $args

    # Actually $canvas is the same as $path
    set canvas [eval [list canvas $path] [Widget::subcget $path :cmd] \
                    -highlightthickness 0 -borderwidth 0 -relief flat]

    # Initialization: mouse is within frame
    set mouseover($canvas) 1

    set onlyhover [Widget::cget $path -onlyhover]

    if {[Widget::theme]} {
	set frame [eval [list ttk::frame $path.frame] \
		       [Widget::subcget $path .frame]]
................................................................................
        [list ScrollableFrame::_frameConfigure $canvas]
    bind $frame <Unmap> \
        [list ScrollableFrame::_frameConfigure $canvas 1]

    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]

    if {$onlyhover} {
        # Show scrollbar if mouse within frame
        bind [winfo parent $path] <Enter> [list ScrollableFrame::enter $canvas]
        # Hide scrollbar if mouse leaves frame
        bind [winfo parent $path] <Leave> [list ScrollableFrame::leave $canvas]
    }

    return [Widget::create ScrollableFrame $path]
}

# ----------------------------------------------------------------------------
#  Command ScrollableFrame::enter
# ----------------------------------------------------------------------------
# Show scrollbars as mouse entered frame
proc ScrollableFrame::enter {canvas} {
    variable mouseover
    set mouseover($canvas) 1
    ScrollableFrame::_frameConfigure $canvas
}

# ----------------------------------------------------------------------------
#  Command ScrollableFrame::leave
# ----------------------------------------------------------------------------
# Hide scrollbars as mouse left frame
proc ScrollableFrame::leave {canvas} {
    variable mouseover
    set mouseover($canvas) 0
    ScrollableFrame::_frameConfigure $canvas 1
}

# ----------------------------------------------------------------------------
................................................................................
    set y1  [expr {$y0+[winfo height $widget]}]
    set xb0 [$path:cmd canvasx 0]
    set yb0 [$path:cmd canvasy 0]
    set xb1 [$path:cmd canvasx [winfo width  $path]]
    set yb1 [$path:cmd canvasy [winfo height $path]]
    set dx  0
    set dy  0
    
    if { [string equal $horz "left"] } {
	if { $x1 > $xb1 } {
	    set dx [expr {$x1-$xb1}]
	}
	if { $x0 < $xb0+$dx } {
	    set dx [expr {$x0-$xb0}]
	}
................................................................................
}


# ----------------------------------------------------------------------------
#  Command ScrollableFrame::_frameConfigure
# ----------------------------------------------------------------------------
proc ScrollableFrame::_max {a b} {return [expr {$a <= $b ? $b : $a}]}
proc ::ScrollableFrame::_frameConfigure {canvas {unmap 0}} {
    variable mouseover
    # Allow to hide scrollbar


















    if {$mouseover($canvas)==0} {
        set unmap 1
    }

    ## There is a bug in BWidget 1.9.0 related to the ScrollableFrame.
    # Described in https://groups.google.com/forum/#!topic/comp.lang.tcl/Q5prg9lsOYc
    # This added code solves the problem (see https://core.tcl.tk/bwidget/tktview/72a5727d1b7fb76b32cea032eb7d4bf7c6fa28bf)

Changes to scrollw.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
..
41
42
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
#     - ScrolledWindow::_set_vscroll
#     - ScrolledWindow::_setData
#     - ScrolledWindow::_setSBSize
#     - ScrolledWindow::_realize
# -----------------------------------------------------------------------------

namespace eval ScrolledWindow {
    # This new global variable makes possible that the scrollbar is shown only when the mouse is over the frame
    array set mouseover {}

    Widget::define ScrolledWindow scrollw

    Widget::declare ScrolledWindow {
	{-background  TkResource ""   0 button}
	{-scrollbar   Enum	 both 0 {none both vertical horizontal}}
................................................................................
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::create
# -----------------------------------------------------------------------------
proc ScrolledWindow::create { path args } {
    # This new global variable makes possible that the scrollbar is shown only when the mouse is over the frame
    variable mouseover
    # Initialize it to 1 (mouse is over the frame)

    set mouseover($path) 1

    Widget::init ScrolledWindow $path $args

    Widget::getVariable $path data

    set bg     [Widget::cget $path -background]
................................................................................
    grid columnconfigure $path 1 -weight 1
    grid rowconfigure	 $path 1 -weight 1

    bind $path <Configure> [list ScrolledWindow::_realize $path]
    bind $path <Destroy>   [list ScrolledWindow::_destroy $path]

    if {$onlyhover} {
        # This makes possible that the scrollbar is shown only when the mouse is over the frame
        bind [winfo parent $path] <Enter> [list ScrolledWindow::enter $path]
        # This makes possible that the scrollbar is hidden only when the mouse is not over the frame
        bind [winfo parent $path] <Leave> [list ScrolledWindow::leave $path]
    }

    return [Widget::create ScrolledWindow $path]
}


# ----------------------------------------------------------------------------
#  Command ScrolledWindow::enter
# ----------------------------------------------------------------------------
# This makes possible that the scrollbar is shown only when the mouse is over the frame
proc ScrolledWindow::enter {path} {
    variable mouseover
    set mouseover($path) 1

    Widget::getVariable $path data

    foreach {vmin vmax} [$path.hscroll get] { break }
................................................................................
    }
    return -code continue
}

# ----------------------------------------------------------------------------
#  Command ScrolledWindow::leave
# ----------------------------------------------------------------------------
# This makes possible that the scrollbar is hidden only when the mouse is not over the frame
proc ScrolledWindow::leave {path} {
    variable mouseover
    set mouseover($path) 0

    Widget::getVariable $path data

    set data(hsb,packed) 0






|







 







<

<
>







 







|

|










|







 







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
..
41
42
43
44
45
46
47

48

49
50
51
52
53
54
55
56
...
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#     - ScrolledWindow::_set_vscroll
#     - ScrolledWindow::_setData
#     - ScrolledWindow::_setSBSize
#     - ScrolledWindow::_realize
# -----------------------------------------------------------------------------

namespace eval ScrolledWindow {
    # hide scrollbars if mouse not within frame
    array set mouseover {}

    Widget::define ScrolledWindow scrollw

    Widget::declare ScrolledWindow {
	{-background  TkResource ""   0 button}
	{-scrollbar   Enum	 both 0 {none both vertical horizontal}}
................................................................................
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::create
# -----------------------------------------------------------------------------
proc ScrolledWindow::create { path args } {

    variable mouseover

    # Initialization: mouse within frame
    set mouseover($path) 1

    Widget::init ScrolledWindow $path $args

    Widget::getVariable $path data

    set bg     [Widget::cget $path -background]
................................................................................
    grid columnconfigure $path 1 -weight 1
    grid rowconfigure	 $path 1 -weight 1

    bind $path <Configure> [list ScrolledWindow::_realize $path]
    bind $path <Destroy>   [list ScrolledWindow::_destroy $path]

    if {$onlyhover} {
        # Show scrollbar if mouse within frame
        bind [winfo parent $path] <Enter> [list ScrolledWindow::enter $path]
        # Hide scrollbar if mouse leaves frame
        bind [winfo parent $path] <Leave> [list ScrolledWindow::leave $path]
    }

    return [Widget::create ScrolledWindow $path]
}


# ----------------------------------------------------------------------------
#  Command ScrolledWindow::enter
# ----------------------------------------------------------------------------
# Show scrollbars as mouse entered frame
proc ScrolledWindow::enter {path} {
    variable mouseover
    set mouseover($path) 1

    Widget::getVariable $path data

    foreach {vmin vmax} [$path.hscroll get] { break }
................................................................................
    }
    return -code continue
}

# ----------------------------------------------------------------------------
#  Command ScrolledWindow::leave
# ----------------------------------------------------------------------------
# Hide scrollbars as mouse left frame
proc ScrolledWindow::leave {path} {
    variable mouseover
    set mouseover($path) 0

    Widget::getVariable $path data

    set data(hsb,packed) 0