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