1# -*- tcl -*-
2#
3#  statusbar.tcl -
4#	Create a status bar Tk widget
5#
6# RCS: @(#) $Id: statusbar.tcl,v 1.8 2010/06/01 18:06:52 hobbs Exp $
7#
8
9# Creation and Options - widget::scrolledwindow $path ...
10#
11#  -separator -default 1 ; show horizontal separator on top of statusbar
12#  -resize    -default 1 ; show resize control on bottom right
13#  -resizeseparator -default 1 ; show separator for resize control
14#  ## Padding can be a list of {padx pady}
15#  -ipad -default 1 ; provides padding around each status bar item
16#  -pad  -default 0 ; provides general padding around the status bar
17#
18#  All other options to frame
19#
20# Methods
21#  $path getframe           => $frame
22#  $path add $widget ?args? => $widget
23#  All other methods to frame
24#
25# Bindings
26#  NONE
27#
28#  Provides a status bar to be placed at the bottom of a toplevel.
29#  Currently does not support being placed in a toplevel that has
30#  gridding applied (via widget -setgrid or wm grid).
31#
32#  Ensure that the widget is placed at the very bottom of the toplevel,
33#  otherwise the resize behavior may behave oddly.
34#
35
36package require widget
37
38if {0} {
39    proc sample {} {
40    # sample usage
41    eval destroy [winfo children .]
42    pack [text .t -width 0 -height 0] -fill both -expand 1
43
44    set sbar .s
45    widget::statusbar $sbar
46    pack $sbar -side bottom -fill x
47    set f [$sbar getframe]
48
49    # Specify -width 1 for the label widget so it truncates nicely
50    # instead of requesting large sizes for long messages
51    set w [label $f.status -width 1 -anchor w -textvariable ::STATUS]
52    set ::STATUS "This is a status message"
53    # give the entry weight, as we want it to be the one that expands
54    $sbar add $w -weight 1
55
56    # BWidget's progressbar
57    set w [ProgressBar $f.bpbar -orient horizontal \
58	       -variable ::PROGRESS -bd 1 -relief sunken]
59    set ::PROGRESS 50
60    $sbar add $w
61    }
62}
63
64snit::widget widget::statusbar {
65    hulltype ttk::frame
66
67    component resizer
68    component separator
69    component sepresize
70    component frame
71
72    # -background, -borderwidth and -relief apply to outer frame, but relief
73    # should be left flat for proper look
74    delegate option * to hull
75    delegate method * to hull
76
77    option -separator       -default 1 -configuremethod C-separator \
78	-type [list snit::boolean]
79    option -resize          -default 1 -configuremethod C-resize \
80	-type [list snit::boolean]
81    option -resizeseparator -default 1 -configuremethod C-resize \
82	-type [list snit::boolean]
83    # -pad provides general padding around the status bar
84    # -ipad provides padding around each status bar item
85    # Padding can be a list of {padx pady}
86    option -ipad -default 2 -configuremethod C-ipad \
87	-type [list snit::listtype -type {snit::integer} -minlen 1 -maxlen 4]
88    delegate option -pad to frame as -padding
89
90    variable ITEMS -array {}
91    variable uid 0
92
93    constructor args {
94	$hull configure -height 18
95
96	install frame using ttk::frame $win.frame
97
98	install resizer using ttk::sizegrip $win.resizer
99
100	install separator using ttk::separator $win.separator \
101	    -orient horizontal
102
103	install sepresize using ttk::separator $win.sepresize \
104	    -orient vertical
105
106	grid $separator -row 0 -column 0 -columnspan 3 -sticky ew
107	grid $frame     -row 1 -column 0 -sticky news
108	grid $sepresize -row 1 -column 1 -sticky ns;# -padx $ipadx -pady $ipady
109	grid $resizer   -row 1 -column 2 -sticky se
110	grid columnconfigure $win 0 -weight 1
111
112	$self configurelist $args
113    }
114
115    method C-ipad {option value} {
116	set options($option) $value
117	# returns pad values - each will be a list of 2 ints
118	foreach {px py} [$self _padval $value] { break }
119	foreach w [grid slaves $frame] {
120	    if {[string match _sep* $w]} {
121		grid configure $w -padx $px -pady 0
122	    } else {
123		grid configure $w -padx $px -pady $py
124	    }
125	}
126    }
127
128    method C-separator {option value} {
129	set options($option) $value
130	if {$value} {
131	    grid $separator
132	} else {
133	    grid remove $separator
134	}
135    }
136
137    method C-resize {option value} {
138	set options($option) $value
139	if {$options(-resize)} {
140	    if {$options(-resizeseparator)} {
141		grid $sepresize
142	    }
143	    grid $resizer
144	} else {
145	    grid remove $sepresize $resizer
146	}
147    }
148
149    # Use this or 'add' - but not both
150    method getframe {} { return $frame }
151
152    method add {what args} {
153	if {[winfo exists $what]} {
154	    set w $what
155	    set symbol $w
156	    set ours 0
157	} else {
158	    set w $frame._$what[incr uid]
159	    set symbol [lindex $args 0]
160	    set args [lrange $args 1 end]
161	    if {![llength $args] || $symbol eq "%AUTO%"} {
162		# Autogenerate symbol name
163		set symbol _$what$uid
164	    }
165	    if {[info exists ITEMS($symbol)]} {
166		return -code error "item '$symbol' already exists"
167	    }
168	    if {$what eq "label" || $what eq "button"
169		|| $what eq "checkbutton" || $what eq "radiobutton"} {
170		set w [ttk::$what $w -style Toolbutton -takefocus 0]
171	    } elseif {$what eq "separator"} {
172		set w [ttk::separator $w -orient vertical]
173	    } elseif {$what eq "space"} {
174		set w [ttk::frame $w]
175	    } else {
176		return -code error "unknown item type '$what'"
177	    }
178	    set ours 1
179	}
180	set opts(-weight)	[string equal $what "space"]
181	set opts(-separator)	0
182	set opts(-sticky)	news
183	set opts(-pad)		$options(-ipad)
184	if {$what eq "separator"} {
185	    # separators should not have pady by default
186	    lappend opts(-pad) 0
187	}
188	set cmdargs [list]
189	set len [llength $args]
190	for {set i 0} {$i < $len} {incr i} {
191	    set key [lindex $args $i]
192	    set val [lindex $args [incr i]]
193	    if {$key eq "--"} {
194		eval [list lappend cmdargs] [lrange $args $i end]
195		break
196	    }
197	    if {[info exists opts($key)]} {
198		set opts($key) $val
199	    } else {
200		# no error - pass to command
201		lappend cmdargs $key $val
202	    }
203	}
204	if {[catch {eval [linsert $cmdargs 0 $w configure]} err]} {
205	    # we only want to destroy widgets we created
206	    if {$ours} { destroy $w }
207	    return -code error $err
208	}
209	set ITEMS($symbol) $w
210	widget::isa listofint 4 -pad $opts(-pad)
211	# returns pad values - each will be a list of 2 ints
212	foreach {px py} [$self _padval $opts(-pad)] { break }
213
214	# get cols,rows extent
215	foreach {cols rows} [grid size $frame] break
216	# Add separator if requested, and we aren't the first element
217	if {$opts(-separator) && $cols != 0} {
218	    set sep [ttk::separator $frame._sep[winfo name $w] \
219			 -orient vertical]
220	    # No pady for separators, and adjust padx for separator space
221	    set sx $px
222	    if {[lindex $sx 0] < 2} { lset sx 0 2 }
223	    lset px 1 0
224	    grid $sep -row 0 -column $cols -sticky ns -padx $sx -pady 0
225	    incr cols
226	}
227
228	grid $w -in $frame -row 0 -column $cols -sticky $opts(-sticky) \
229	    -padx $px -pady $py
230	grid columnconfigure $frame $cols -weight $opts(-weight)
231
232	return $symbol
233    }
234
235    method remove {args} {
236	set destroy [string equal [lindex $args 0] "-destroy"]
237	if {$destroy} {
238	    set args [lrange $args 1 end]
239	}
240	foreach sym $args {
241	    # Should we ignore unknown (possibly already removed) items?
242	    #if {![info exists ITEMS($sym)]} { continue }
243	    set w $ITEMS($sym)
244	    # separator name is based off item name
245	    set sep $frame._sep[winfo name $w]
246	    # destroy separator for remove or destroy case
247	    destroy $sep
248	    if {$destroy} {
249		destroy $w
250	    } else {
251		grid forget $w
252	    }
253	    unset ITEMS($sym)
254	}
255    }
256
257    method delete {args} {
258	eval [linsert $args 0 $self remove -destroy]
259    }
260
261    method items {{ptn *}} {
262	# return from ordered list
263	if {$ptn ne "*"} {
264	    return [array names ITEMS $ptn]
265	}
266	return [array names ITEMS]
267    }
268
269    method _padval {val} {
270	set len [llength $val]
271	if {$len == 0} {
272	    return [list 0 0 0 0]
273	} elseif {$len == 1} {
274	    return [list [list $val $val] [list $val $val]]
275	} elseif {$len == 2} {
276	    set x [lindex $val 0] ; set y [lindex $val 1]
277	    return [list [list $x $x] [list $y $y]]
278	} elseif {$len == 3} {
279	    return [list [list [lindex $val 0] [lindex $val 2]] \
280			[list [lindex $val 1] [lindex $val 1]]]
281	} else {
282	    return $val
283	}
284    }
285}
286
287package provide widget::statusbar 1.2.1
288