1# -*- tcl -*-
2#
3# toolbar - /snit::widget
4#	Manage items in a toolbar.
5#
6# RCS: @(#) $Id: toolbar.tcl,v 1.12 2010/06/01 18:06:52 hobbs Exp $
7#
8
9#  ## Padding can be a list of {padx pady}
10#  -ipad -default 1 ; provides padding around each status bar item
11#  -pad  -default 0 ; provides general padding around the status bar
12#  -separator -default {} ; one of {top left bottom right {}}
13#
14#  All other options to frame
15#
16# Methods
17#  $path getframe           => $frame
18#  $path add $widget ?args? => $widget
19#  All other methods to frame
20#
21# Bindings
22#  NONE
23#
24
25if 0 {
26    # Example
27    lappend auto_path ~/cvs/tcllib/tklib/modules/widget
28
29    package require widget::toolbar
30    set f [ttk::frame .f -padding 4]
31    pack $f -fill both -expand 1
32    set tb [widget::toolbar .f.tb]
33    pack $tb -fill both -expand 1
34    $tb add button foo -text Foo
35    $tb add button bar -text Bar -separator 1
36    $tb add button baz -text Baz
37    set b [ttk::button $tb.zippy -text Zippy -state disabled]
38    $tb add $b
39}
40
41package require widget
42#package require tooltip
43
44snit::widget widget::toolbar {
45    hulltype ttk::frame
46
47    component separator
48    component frame
49
50    delegate option * to hull
51    delegate method * to hull
52
53    option -wrap -default 0 -type [list snit::boolean]
54    option -separator -default {} -configuremethod C-separator \
55	-type [list snit::enum -values [list top left bottom right {}]]
56    # -pad provides general padding around the status bar
57    # -ipad provides padding around each status bar item
58    # Padding can be a list of {padx pady}
59    option -ipad -default 2 -configuremethod C-ipad \
60	-type [list snit::listtype -type {snit::integer} -minlen 1 -maxlen 4]
61    delegate option -pad to frame as -padding
62
63    variable ITEMS -array {}
64    variable uid 0
65
66    constructor {args} {
67	$hull configure -height 18
68
69	install frame using ttk::frame $win.frame
70
71	install separator using ttk::separator $win.separator
72
73	grid $frame -row 1 -column 1 -sticky news
74	grid columnconfigure $win 1 -weight 1
75
76	# we should have a <Configure> binding to wrap long toolbars
77	#bind $win <Configure> [mymethod resize [list $win] %w]
78
79	$self configurelist $args
80    }
81
82    method C-ipad {option value} {
83	set options($option) $value
84	# returns pad values - each will be a list of 2 ints
85	foreach {px py} [$self _padval $value] { break }
86	foreach w [grid slaves $frame] {
87	    if {[string match _sep* $w]} {
88		grid configure $w -padx $px -pady 0
89	    } else {
90		grid configure $w -padx $px -pady $py
91	    }
92	}
93    }
94
95    method C-separator {option value} {
96	set options($option) $value
97	switch -exact -- $value {
98	    top {
99		$separator configure -orient horizontal
100		grid $separator -row 0 -column 1 -sticky ew
101	    }
102	    left {
103		$separator configure -orient vertical
104		grid $separator -row 1 -column 0 -sticky ns
105	    }
106	    bottom {
107		$separator configure -orient horizontal
108		grid $separator -row 2 -column 1 -sticky ew
109	    }
110	    right {
111		$separator configure -orient vertical
112		grid $separator -row 1 -column 2 -sticky ns
113	    }
114	    {} {
115		grid remove $separator
116	    }
117	}
118    }
119
120    # Use this or 'add' - but not both
121    method getframe {} { return $frame }
122
123    method add {what args} {
124	if {[winfo exists $what]} {
125	    set w $what
126	    set symbol $w
127	    set ours 0
128	} else {
129	    set w $frame._$what[incr uid]
130	    set symbol [lindex $args 0]
131	    set args [lrange $args 1 end]
132	    if {![llength $args] || $symbol eq "%AUTO%"} {
133		# Autogenerate symbol name
134		set symbol _$what$uid
135	    }
136	    if {[info exists ITEMS($symbol)]} {
137		return -code error "item '$symbol' already exists"
138	    }
139	    if {$what eq "label" || $what eq "button"
140		|| $what eq "checkbutton" || $what eq "radiobutton"} {
141		set w [ttk::$what $w -style Toolbutton -takefocus 0]
142	    } elseif {$what eq "separator"} {
143		set w [ttk::separator $w -orient vertical]
144	    } elseif {$what eq "space"} {
145		set w [ttk::frame $w]
146	    } else {
147		return -code error "unknown item type '$what'"
148	    }
149	    set ours 1
150	}
151	set opts(-weight)	[string equal $what "space"]
152	set opts(-separator)	0
153	set opts(-sticky)	news
154	set opts(-pad)		$options(-ipad)
155	if {$what eq "separator"} {
156	    # separators should not have pady by default
157	    lappend opts(-pad) 0
158	}
159	set cmdargs [list]
160	set len [llength $args]
161	for {set i 0} {$i < $len} {incr i} {
162	    set key [lindex $args $i]
163	    set val [lindex $args [incr i]]
164	    if {$key eq "--"} {
165		eval [list lappend cmdargs] [lrange $args $i end]
166		break
167	    }
168	    if {[info exists opts($key)]} {
169		set opts($key) $val
170	    } else {
171		# no error - pass to command
172		lappend cmdargs $key $val
173	    }
174	}
175	if {[catch {eval [linsert $cmdargs 0 $w configure]} err]} {
176	    # we only want to destroy widgets we created
177	    if {$ours} { destroy $w }
178	    return -code error $err
179	}
180	set ITEMS($symbol) $w
181	widget::isa listofint 4 -pad $opts(-pad)
182	# returns pad values - each will be a list of 2 ints
183	foreach {px py} [$self _padval $opts(-pad)] { break }
184
185	# get cols,rows extent
186	foreach {cols rows} [grid size $frame] break
187	# Add separator if requested, and we aren't the first element
188	if {$opts(-separator) && $cols != 0} {
189	    set sep [ttk::separator $frame._sep[winfo name $w] \
190			 -orient vertical]
191	    # No pady for separators, and adjust padx for separator space
192	    set sx [lindex $px 0]
193	    if {$sx < 2} { set sx 2 }
194	    lset px 0 0
195	    grid $sep -row 0 -column $cols -sticky ns -padx $sx -pady 0
196	    incr cols
197	}
198
199	grid $w -in $frame -row 0 -column $cols -sticky $opts(-sticky) \
200	    -pady $py -padx $px
201	grid columnconfigure $frame $cols -weight $opts(-weight)
202
203	return $symbol
204    }
205
206    method remove {args} {
207	set destroy [string equal [lindex $args 0] "-destroy"]
208	if {$destroy} {
209	    set args [lrange $args 1 end]
210	}
211	foreach sym $args {
212	    # Should we ignore unknown (possibly already removed) items?
213	    #if {![info exists ITEMS($sym)]} { continue }
214	    set w $ITEMS($sym)
215	    # separator name is based off item name
216	    set sep $frame._sep[winfo name $w]
217	    # destroy separator for remove or destroy case
218	    destroy $sep
219	    if {$destroy} {
220		destroy $w
221	    } else {
222		grid forget $w
223	    }
224	    unset ITEMS($sym)
225	    # XXX separator of next item is no longer necessary, if it exists
226	}
227    }
228
229    method delete {args} {
230	eval [linsert $args 0 $self remove -destroy]
231    }
232
233    method itemconfigure {symbol args} {
234	if {[info exists ITEMS($symbol)]} {
235	    # configure exact item
236	    return [eval [linsert $args 0 $ITEMS($symbol) configure]]
237	}
238	# configure based on $symbol as a glob pattern
239	set res {}
240	foreach sym [array names ITEMS -glob $symbol] {
241	    lappend res \
242		[catch { eval [linsert $args 0 $ITEMS($sym) configure] } msg] \
243		$msg
244	}
245	# return something when we can figure out what is good to return
246	#return $res
247    }
248
249    method itemcget {symbol option} {
250	if {![info exists ITEMS($symbol)]} {
251	    return -code error "unknown toolbar item '$symbol'"
252	}
253	return [$ITEMS($symbol) cget $option]
254    }
255
256    method itemid {symbol} {
257	if {![info exists ITEMS($symbol)]} {
258	    return -code error "unknown toolbar item '$symbol'"
259	}
260	return $ITEMS($symbol)
261    }
262
263    method items {{ptn *}} {
264	if {$ptn ne "*"} {
265	    return [array names ITEMS $ptn]
266	}
267	return [array names ITEMS]
268    }
269
270    method _padval {val} {
271	set len [llength $val]
272	if {$len == 0} {
273	    return [list 0 0 0 0]
274	} elseif {$len == 1} {
275	    return [list [list $val $val] [list $val $val]]
276	} elseif {$len == 2} {
277	    set x [lindex $val 0] ; set y [lindex $val 1]
278	    return [list [list $x $x] [list $y $y]]
279	} elseif {$len == 3} {
280	    return [list [list [lindex $val 0] [lindex $val 2]] \
281			[list [lindex $val 1] [lindex $val 1]]]
282	} else {
283	    return $val
284	}
285    }
286
287    method resize {w width} {
288	if {$w ne $win} { return }
289	if {$width < [winfo reqwidth $win]} {
290	    # Take the last column item and move it down
291	}
292    }
293
294}
295
296package provide widget::toolbar 1.2.1
297