1# -*- tcl -*- 2# 3# scrollw.tcl - 4# 5# Scrolled widget 6# 7# RCS: @(#) $Id: scrollw.tcl,v 1.15 2010/06/01 18:06:52 hobbs Exp $ 8# 9 10# Creation and Options - widget::scrolledwindow $path ... 11# -scrollbar -default "both" ; vertical horizontal none 12# -auto -default "both" ; vertical horizontal none 13# -sides -default "se" ; 14# -size -default 0 ; scrollbar -width (not recommended to change) 15# -ipad -default {0 0} ; represents internal {x y} padding between 16# ; scrollbar and given widget 17# All other options to frame 18# 19# Methods 20# $path getframe => $frame 21# $path setwidget $widget => $widget 22# All other methods to frame 23# 24# Bindings 25# NONE 26# 27 28if 0 { 29 # Samples 30 package require widget::scrolledwindow 31 #set sw [widget::scrolledwindow .sw -scrollbar vertical] 32 #set text [text .sw.text -wrap word] 33 #$sw setwidget $text 34 #pack $sw -fill both -expand 1 35 36 set sw [widget::scrolledwindow .sw -borderwidth 1 -relief sunken] 37 set text [text $sw.text -borderwidth 0 -height 4 -width 20] 38 $sw setwidget $text 39 pack $sw -fill both -expand 1 -padx 4 -pady 4 40 41 set sw [widget::scrolledwindow .ssw -borderwidth 2 -relief solid] 42 set text [text $sw.text -borderwidth 0 -height 4 -width 20] 43 $sw setwidget $text 44 pack $sw -fill both -expand 1 -padx 4 -pady 4 45} 46 47### 48 49package require widget 50 51snit::widget widget::scrolledwindow { 52 hulltype ttk::frame 53 54 component hscroll 55 component vscroll 56 57 delegate option * to hull 58 delegate method * to hull 59 #delegate option -size to {hscroll vscroll} as -width 60 61 option -scrollbar -default "both" -configuremethod C-scrollbar \ 62 -type [list snit::enum -values [list none horizontal vertical both]] 63 option -auto -default "both" -configuremethod C-scrollbar \ 64 -type [list snit::enum -values [list none horizontal vertical both]] 65 option -sides -default "se" -configuremethod C-scrollbar \ 66 -type [list snit::enum -values [list ne en nw wn se es sw ws]] 67 option -size -default 0 -configuremethod C-size \ 68 -type [list snit::integer -min 0 -max 30] 69 option -ipad -default 0 -configuremethod C-ipad \ 70 -type [list snit::listtype -type {snit::integer} -minlen 1 -maxlen 2] 71 72 typevariable scrollopts {none horizontal vertical both} 73 74 variable realized 0 ; # set when first Configure'd 75 variable hsb -array { 76 packed 0 present 0 auto 0 row 2 col 1 lastmin -1 lastmax -1 lock 0 77 sticky "ew" padx 0 pady 0 78 } 79 variable vsb -array { 80 packed 0 present 0 auto 0 row 1 col 2 lastmin -1 lastmax -1 lock 0 81 sticky "ns" padx 0 pady 0 82 } 83 variable pending {} ; # pending after id for scrollbar mgmt 84 85 constructor args { 86 if {[tk windowingsystem] ne "aqua"} { 87 # ttk scrollbars on aqua are a bit wonky still 88 install hscroll using ttk::scrollbar $win.hscroll \ 89 -orient horizontal -takefocus 0 90 install vscroll using ttk::scrollbar $win.vscroll \ 91 -orient vertical -takefocus 0 92 } else { 93 install hscroll using scrollbar $win.hscroll \ 94 -orient horizontal -takefocus 0 95 install vscroll using scrollbar $win.vscroll \ 96 -orient vertical -takefocus 0 97 # in case the scrollbar has been overridden ... 98 catch {$hscroll configure -highlightthickness 0} 99 catch {$vscroll configure -highlightthickness 0} 100 } 101 102 set hsb(bar) $hscroll 103 set vsb(bar) $vscroll 104 bind $win <Configure> [mymethod _realize $win] 105 106 grid columnconfigure $win 1 -weight 1 107 grid rowconfigure $win 1 -weight 1 108 109 set pending [after idle [mymethod _setdata]] 110 $self configurelist $args 111 } 112 113 destructor { 114 after cancel $pending 115 set pending {} 116 } 117 118 # Do we need this ?? 119 method getframe {} { return $win } 120 121 variable setwidget {} 122 method setwidget {widget} { 123 if {$setwidget eq $widget} { return } 124 if {[winfo exists $setwidget]} { 125 grid remove $setwidget 126 # in case we only scroll in one direction 127 catch {$setwidget configure -xscrollcommand ""} 128 catch {$setwidget configure -yscrollcommand ""} 129 $hscroll configure -command {} 130 $vscroll configure -command {} 131 set setwidget {} 132 } 133 if {$pending ne {}} { 134 # ensure we have called most recent _setdata 135 after cancel $pending 136 $self _setdata 137 } 138 if {[winfo exists $widget]} { 139 set setwidget $widget 140 grid $widget -in $win -row 1 -column 1 -sticky news 141 142 # in case we only scroll in one direction 143 if {$hsb(present)} { 144 $widget configure -xscrollcommand [mymethod _set_scroll hsb] 145 $hscroll configure -command [list $widget xview] 146 } 147 if {$vsb(present)} { 148 $widget configure -yscrollcommand [mymethod _set_scroll vsb] 149 $vscroll configure -command [list $widget yview] 150 } 151 } 152 return $widget 153 } 154 155 method C-size {option value} { 156 set options($option) $value 157 $vscroll configure -width $value 158 $hscroll configure -width $value 159 } 160 161 method C-scrollbar {option value} { 162 set options($option) $value 163 after cancel $pending 164 set pending [after idle [mymethod _setdata]] 165 } 166 167 method C-ipad {option value} { 168 set options($option) $value 169 # double value to ensure a single int value covers pad x and y 170 foreach {padx pady} [concat $value $value] { break } 171 set vsb(padx) [list $padx 0] ; set vsb(pady) 0 172 set hsb(padx) 0 ; set vsb(pady) [list $pady 0] 173 if {$vsb(present) && $vsb(packed)} { 174 grid configure $vsb(bar) -padx $vsb(padx) -pady $vsb(pady) 175 } 176 if {$hsb(present) && $hsb(packed)} { 177 grid configure $hsb(bar) -padx $hsb(padx) -pady $hsb(pady) 178 } 179 } 180 181 method _set_scroll {varname vmin vmax} { 182 if {!$realized} { return } 183 # This is only called if the scrollbar is attached properly 184 upvar 0 $varname sb 185 if {$sb(auto)} { 186 if {!$sb(lock)} { 187 # One last check to avoid loops when not locked 188 if {$vmin == $sb(lastmin) && $vmax == $sb(lastmax)} { 189 return 190 } 191 set sb(lastmin) $vmin 192 set sb(lastmax) $vmax 193 } 194 if {$sb(packed) && $vmin == 0 && $vmax == 1} { 195 if {!$sb(lock)} { 196 set sb(packed) 0 197 grid remove $sb(bar) 198 } 199 } elseif {!$sb(packed) && ($vmin != 0 || $vmax != 1)} { 200 set sb(packed) 1 201 grid $sb(bar) -column $sb(col) -row $sb(row) \ 202 -sticky $sb(sticky) -padx $sb(padx) -pady $sb(pady) 203 } 204 set sb(lock) 1 205 update idletasks 206 set sb(lock) 0 207 } 208 $sb(bar) set $vmin $vmax 209 } 210 211 method _setdata {} { 212 set pending {} 213 set bar [lsearch -exact $scrollopts $options(-scrollbar)] 214 set auto [lsearch -exact $scrollopts $options(-auto)] 215 216 set hsb(present) [expr {$bar & 1}] ; # idx 1 or 3 217 set hsb(auto) [expr {$auto & 1}] ; # idx 1 or 3 218 set hsb(row) [expr {[string match *n* $options(-sides)] ? 0 : 2}] 219 set hsb(col) 1 220 set hsb(sticky) "ew" 221 222 set vsb(present) [expr {$bar & 2}] ; # idx 2 223 set vsb(auto) [expr {$auto & 2}] ; # idx 2 224 set vsb(row) 1 225 set vsb(col) [expr {[string match *w* $options(-sides)] ? 0 : 2}] 226 set vsb(sticky) "ns" 227 228 if {$setwidget eq ""} { 229 grid remove $hsb(bar) 230 grid remove $vsb(bar) 231 set hsb(packed) 0 232 set vsb(packed) 0 233 return 234 } 235 236 foreach varname {hsb vsb} { 237 upvar 0 $varname sb 238 foreach {vmin vmax} [$sb(bar) get] { break } 239 set sb(packed) [expr {$sb(present) && 240 (!$sb(auto) || ($vmin != 0 || $vmax != 1))}] 241 if {$sb(packed)} { 242 grid $sb(bar) -column $sb(col) -row $sb(row) \ 243 -sticky $sb(sticky) -padx $sb(padx) -pady $sb(pady) 244 } else { 245 grid remove $sb(bar) 246 } 247 } 248 } 249 250 method _realize {w} { 251 if {$w eq $win} { 252 bind $win <Configure> {} 253 set realized 1 254 } 255 } 256} 257 258package provide widget::scrolledwindow 1.2.1 259