1# ----------------------------------------------------------------------------
2#  buttonbox.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: buttonbox.tcl,v 1.15 2009/11/01 20:20:50 oberdorfer Exp $
5# ----------------------------------------------------------------------------
6#  Index of commands:
7#     - ButtonBox::create
8#     - ButtonBox::configure
9#     - ButtonBox::cget
10#     - ButtonBox::add
11#     - ButtonBox::itemconfigure
12#     - ButtonBox::itemcget
13#     - ButtonBox::setfocus
14#     - ButtonBox::invoke
15#     - ButtonBox::index
16#     - ButtonBox::_destroy
17#     - ButtonBox::_themechanged
18# ----------------------------------------------------------------------------
19
20namespace eval ButtonBox {
21    Widget::define ButtonBox buttonbox Button
22
23    Widget::declare ButtonBox {
24        {-background  Color     "SystemWindowFrame" 0}
25	{-orient      Enum	 horizontal 1 {horizontal vertical}}
26	{-state	      Enum	 "normal"   0 {normal disabled}}
27	{-homogeneous Boolean	 1	    1}
28	{-spacing     Int	 10	    0 "%d >= 0"}
29	{-padx	      TkResource ""	    0 button}
30	{-pady	      TkResource ""	    0 button}
31	{-default     Int	 -1	    0 "%d >= -1"}
32	{-bg	      Synonym	 -background}
33        {-style       String "" 0}
34    }
35
36    if { ![BWidget::using ttk] } {
37        Widget::addmap ButtonBox "" :cmd {-background {}}
38    }
39    if { [BWidget::using ttk] } {
40        Widget::addmap Button "" :cmd {-style {}}
41    }
42
43    Widget::addmap ButtonBox "" :cmd {-background {}}
44
45    bind ButtonBox <Destroy> [list ButtonBox::_destroy %W]
46
47    if {[lsearch [bindtags .] ButtonBoxThemeChanged] < 0} {
48        bindtags . [linsert [bindtags .] 1 ButtonBoxThemeChanged]
49    }
50}
51
52
53# ----------------------------------------------------------------------------
54#  Command ButtonBox::create
55# ----------------------------------------------------------------------------
56proc ButtonBox::create { path args } {
57    Widget::init ButtonBox $path $args
58
59    variable $path
60    upvar 0  $path data
61
62    eval [list frame $path] [Widget::subcget $path :cmd] \
63	 [list -class ButtonBox -takefocus 0 -highlightthickness 0]
64
65    # For 8.4+ we don't want to inherit the padding
66    catch {$path configure -padx 0 -pady 0}
67
68    set data(max)      0
69    set data(nbuttons) 0
70    set data(buttons)  [list]
71    set data(default)  [Widget::getoption $path -default]
72
73    bind ButtonBoxThemeChanged <<ThemeChanged>> \
74	   "+ [namespace current]::_themechanged $path"
75
76    return [Widget::create ButtonBox $path]
77}
78
79
80# ----------------------------------------------------------------------------
81#  Command ButtonBox::configure
82# ----------------------------------------------------------------------------
83proc ButtonBox::configure { path args } {
84    variable $path
85    upvar 0  $path data
86
87    set res [Widget::configure $path $args]
88
89    if { [Widget::hasChanged $path -default val] } {
90        if { $data(default) != -1 && $val != -1 } {
91            set but $path.b$data(default)
92            if { [winfo exists $but] } {
93                $but configure -default normal
94            }
95            set but $path.b$val
96            if { [winfo exists $but] } {
97                $but configure -default active
98            }
99            set data(default) $val
100        } else {
101            Widget::setoption $path -default $data(default)
102        }
103    }
104
105    if {[Widget::hasChanged $path -state val]} {
106	foreach i $data(buttons) {
107	    $path.b$i configure -state $val
108	}
109    }
110
111    return $res
112}
113
114
115# ----------------------------------------------------------------------------
116#  Command ButtonBox::cget
117# ----------------------------------------------------------------------------
118proc ButtonBox::cget { path option } {
119    return [Widget::cget $path $option]
120}
121
122
123# ----------------------------------------------------------------------------
124#  Command ButtonBox::add
125# ----------------------------------------------------------------------------
126proc ButtonBox::add { path args } {
127    return [eval [linsert $args 0 insert $path end]]
128}
129
130
131proc ButtonBox::insert { path idx args } {
132    variable $path
133    upvar 0  $path data
134
135    set but     $path.b$data(nbuttons)
136    set spacing [Widget::getoption $path -spacing]
137
138    ## Save the current spacing setting for this button.  Buttons
139    ## appended to the end of the box have their spacing applied
140    ## to their left while all other have their spacing applied
141    ## to their right.
142    if {$idx == "end"} {
143	set data(spacing,$data(nbuttons)) [list left $spacing]
144	lappend data(buttons) $data(nbuttons)
145    } else {
146	set data(spacing,$data(nbuttons)) [list right $spacing]
147        set data(buttons) [linsert $data(buttons) $idx $data(nbuttons)]
148    }
149
150    if { $data(nbuttons) == $data(default) } {
151        set style active
152    } elseif { $data(default) == -1 } {
153        set style disabled
154    } else {
155        set style normal
156    }
157
158    array set flags $args
159    set tags ""
160    if { [info exists flags(-tags)] } {
161	set tags $flags(-tags)
162	unset flags(-tags)
163	set args [array get flags]
164    }
165
166    eval [list Button::create $but \
167	      -background [Widget::getoption $path -background]\
168	      -padx       [Widget::getoption $path -padx] \
169	      -pady       [Widget::getoption $path -pady]] \
170        $args [list -default $style]
171
172    # a button box button - by default - is flat!
173    if { [BWidget::using ttk] } {
174       $but configure -style [Button::getSlimButtonStyle]
175    }
176
177    # ericm@scriptics.com:  set up tags, just like the menu items
178    foreach tag $tags {
179	lappend data(tags,$tag) $but
180	if { ![info exists data(tagstate,$tag)] } {
181	    set data(tagstate,$tag) 0
182	}
183    }
184    set data(buttontags,$but) $tags
185    # ericm@scriptics.com
186
187    _redraw $path
188
189    incr data(nbuttons)
190
191    return $but
192}
193
194
195proc ButtonBox::delete { path idx } {
196    variable $path
197    upvar 0  $path data
198
199    set i [lindex $data(buttons) $idx]
200    set data(buttons) [lreplace $data(buttons) $idx $idx]
201    destroy $path.b$i
202}
203
204
205# ButtonBox::setbuttonstate --
206#
207#	Set the state of a given button tag.  If this makes any buttons
208#       enable-able (ie, all of their tags are TRUE), enable them.
209#
210# Arguments:
211#	path        the button box widget name
212#	tag         the tag to modify
213#	state       the new state of $tag (0 or 1)
214#
215# Results:
216#	None.
217
218proc ButtonBox::setbuttonstate {path tag state} {
219    variable $path
220    upvar 0  $path data
221    # First see if this is a real tag
222    if { [info exists data(tagstate,$tag)] } {
223	set data(tagstate,$tag) $state
224	foreach but $data(tags,$tag) {
225	    set expression "1"
226	    foreach buttontag $data(buttontags,$but) {
227		append expression " && $data(tagstate,$buttontag)"
228	    }
229	    if { [expr $expression] } {
230		set state normal
231	    } else {
232		set state disabled
233	    }
234	    $but configure -state $state
235	}
236    }
237    return
238}
239
240# ButtonBox::getbuttonstate --
241#
242#	Retrieve the state of a given button tag.
243#
244# Arguments:
245#	path        the button box widget name
246#	tag         the tag to modify
247#
248# Results:
249#	None.
250
251proc ButtonBox::getbuttonstate {path tag} {
252    variable $path
253    upvar 0  $path data
254    # First see if this is a real tag
255    if { [info exists data(tagstate,$tag)] } {
256	return $data(tagstate,$tag)
257    } else {
258	error "unknown tag $tag"
259    }
260}
261
262# ----------------------------------------------------------------------------
263#  Command ButtonBox::itemconfigure
264# ----------------------------------------------------------------------------
265proc ButtonBox::itemconfigure { path index args } {
266    if { [set idx [lsearch $args -default]] != -1 } {
267        set args [lreplace $args $idx [expr {$idx+1}]]
268    }
269    return [eval [list Button::configure $path.b[index $path $index]] $args]
270}
271
272
273# ----------------------------------------------------------------------------
274#  Command ButtonBox::itemcget
275# ----------------------------------------------------------------------------
276proc ButtonBox::itemcget { path index option } {
277    return [Button::cget $path.b[index $path $index] $option]
278}
279
280
281# ----------------------------------------------------------------------------
282#  Command ButtonBox::setfocus
283# ----------------------------------------------------------------------------
284proc ButtonBox::setfocus { path index } {
285    set but $path.b[index $path $index]
286    if { [winfo exists $but] } {
287        focus $but
288    }
289}
290
291
292# ----------------------------------------------------------------------------
293#  Command ButtonBox::invoke
294# ----------------------------------------------------------------------------
295proc ButtonBox::invoke { path index } {
296    set but $path.b[index $path $index]
297    if { [winfo exists $but] } {
298        Button::invoke $but
299    }
300}
301
302
303# ----------------------------------------------------------------------------
304#  Command ButtonBox::index
305# ----------------------------------------------------------------------------
306proc ButtonBox::index { path index } {
307    variable $path
308    upvar 0  $path data
309
310    set n [expr {$data(nbuttons) - 1}]
311
312    if {[string equal $index "default"]} {
313        set res [Widget::getoption $path -default]
314    } elseif {$index == "end" || $index == "last"} {
315	set res $n
316    } elseif {![string is integer -strict $index]} {
317	## It's not an integer.  Search the text of each button
318	## in the box and return the index that matches.
319	foreach i $data(buttons) {
320	    set w $path.b$i
321	    lappend text  [$w cget -text]
322	    lappend names [$w cget -name]
323	}
324	set res [lsearch -exact [concat $names $text] $index]
325    } else {
326        set res $index
327	if {$index > $n} { set res $n }
328    }
329    return $res
330}
331
332
333# ButtonBox::gettags --
334#
335#	Return a list of all the tags on all the buttons in a buttonbox.
336#
337# Arguments:
338#	path      the buttonbox to query.
339#
340# Results:
341#	taglist   a list of tags on the buttons in the buttonbox
342
343proc ButtonBox::gettags {path} {
344    upvar ::ButtonBox::$path data
345    set taglist {}
346    foreach tag [array names data "tags,*"] {
347	lappend taglist [string range $tag 5 end]
348    }
349    return $taglist
350}
351
352
353# ----------------------------------------------------------------------------
354#  Command ButtonBox::_redraw
355# ----------------------------------------------------------------------------
356proc ButtonBox::_redraw { path } {
357    variable $path
358    upvar 0  $path data
359    Widget::getVariable $path buttons
360
361    # For tk >= 8.4, -uniform gridding option is used.
362    # Otherwise, there is the constraint, that button size may not change after
363    # creation.
364    set uniformAvailable [expr {0 <= [package vcompare [info patchlevel] 8.4.0]}]
365
366    ## We re-grid the buttons from left-to-right.  As we go through
367    ## each button, we check its spacing and which direction the
368    ## spacing applies to.  Once spacing has been applied to an index,
369    ## it is not changed.  This means spacing takes precedence from
370    ## left-to-right.
371
372    set idx  0
373    set idxs [list]
374    foreach i $data(buttons) {
375	set dir     [lindex $data(spacing,$i) 0]
376	set spacing [lindex $data(spacing,$i) 1]
377        set but $path.b$i
378        if {[string equal [Widget::getoption $path -orient] "horizontal"]} {
379            grid $but -column $idx -row 0 -sticky nsew
380            if { [Widget::getoption $path -homogeneous] } {
381                if {$uniformAvailable} {
382                    grid columnconfigure $path $idx -uniform koen -weight 1
383                } else {
384                    set req [winfo reqwidth $but]
385                    if { $req > $data(max) } {
386                        grid columnconfigure $path [expr {2*$i}] -minsize $req
387                        set data(max) $req
388                    }
389                    grid columnconfigure $path $idx -weight 1
390                }
391            } else {
392                grid columnconfigure $path $idx -weight 0
393            }
394
395	    set col [expr {$idx - 1}]
396	    if {[string equal $dir "right"]} { set col [expr {$idx + 1}] }
397	    if {$col > 0 && [lsearch $idxs $col] < 0} {
398		lappend idxs $col
399		grid columnconfigure $path $col -minsize $spacing
400	    }
401        } else {
402            grid $but -column 0 -row $idx -sticky nsew
403            grid rowconfigure $path $idx -weight 0
404
405	    set row [expr {$idx - 1}]
406	    if {[string equal $dir "right"]} { set row [expr {$idx + 1}] }
407	    if {$row > 0 && [lsearch $idxs $row] < 0} {
408		lappend idxs $row
409		grid rowconfigure $path $row -minsize $spacing
410	    }
411        }
412        incr idx 2
413    }
414
415    if {!$uniformAvailable} {
416        # Now that the maximum size has been calculated, go back through
417        # and correctly set the size for homogeneous horizontal buttons.
418        if { [string equal [Widget::getoption $path -orient] "horizontal"] && [Widget::getoption $path -homogeneous] } {
419            set idx 0
420            foreach i $data(buttons) {
421                grid columnconfigure $path $idx -minsize $data(max)
422                incr idx 2
423            }
424        }
425    }
426}
427
428
429# ----------------------------------------------------------------------------
430#  Command ButtonBox::_destroy
431# ----------------------------------------------------------------------------
432proc ButtonBox::_destroy { path } {
433    variable $path
434    upvar 0  $path data
435    Widget::destroy $path
436    unset data
437}
438
439# ----------------------------------------------------------------------------
440#  Command ButtonBox::_themechanged
441# ----------------------------------------------------------------------------
442proc ButtonBox::_themechanged { path } {
443
444    if { ![winfo exists $path] } { return }
445    BWidget::set_themedefaults
446
447    $path configure -background $BWidget::colors(SystemWindowFrame)
448}
449