1# ----------------------------------------------------------------------------
2#  statusbar.tcl ---
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: statusbar.tcl,v 1.91 2009/09/06 21:42:14 oberdorfer Exp $
5# ----------------------------------------------------------------------------
6#	Create a status bar Tk widget
7#
8#  Provides a status bar to be placed at the bottom of a toplevel.
9#  Currently does not support being placed in a toplevel that has
10#  gridding applied (via widget -setgrid or wm grid).
11#
12#  Ensure that the widget is placed at the very bottom of the toplevel,
13#  otherwise the resize behavior may behave oddly.
14# ------------------------------------------------------------------------
15#
16
17package require Tk 8.3
18
19if {0} {
20    proc sample {} {
21    # sample usage
22    eval destroy [winfo children .]
23    pack [text .t -width 0 -height 0] -fill both -expand 1
24
25    set sbar .s
26    StatusBar $sbar
27    pack $sbar -side bottom -fill x
28    set f [$sbar getframe]
29
30    # Specify -width 1 for the label widget so it truncates nicely
31    # instead of requesting large sizes for long messages
32    set w [label $f.status -width 1 -anchor w -textvariable ::STATUS]
33    set ::STATUS "This is a status message"
34    # give the entry weight, as we want it to be the one that expands
35    $sbar add $w -weight 1
36
37    # BWidget's progressbar
38    set w [ProgressBar $f.bpbar -orient horizontal \
39	       -variable ::PROGRESS -bd 1 -relief sunken]
40    set ::PROGRESS 50
41    $sbar add $w
42    }
43}
44
45namespace eval StatusBar {
46    Widget::define StatusBar statusbar
47
48    Widget::declare StatusBar {
49	{-background  Color      "SystemWindow"	0}
50	{-borderwidth TkResource 0	0 frame}
51	{-relief      TkResource flat	0 frame}
52	{-showseparator Boolean	 1	0}
53	{-showresizesep Boolean	 0	0}
54	{-showresize  Boolean	 1	0}
55	{-width	      TkResource 100	0 frame}
56	{-height      TkResource 18	0 frame}
57	{-ipad	      String	 1	0}
58	{-pad	      String	 0	0}
59	{-bg	      Synonym	 -background}
60	{-bd	      Synonym	 -borderwidth}
61    }
62
63    # -background, -borderwidth and -relief apply to outer frame, but relief
64    # should be left flat for proper look
65    Widget::addmap StatusBar "" :cmd {
66	-background {} -width {} -height {} -borderwidth {} -relief {}
67    }
68    Widget::addmap StatusBar "" .sbar {
69	-background {}
70    }
71    Widget::addmap StatusBar "" .resize {
72	-background {}
73    }
74    Widget::addmap StatusBar "" .hsep {
75	-background {}
76    }
77
78    # -pad provides general padding around the status bar
79    # -ipad provides padding around each status bar item
80    # Padding can be a list of {padx pady}
81
82    variable HaveMarlett \
83	[expr {[lsearch -exact [font families] "Marlett"] != -1}]
84
85    bind StatusResize <1> \
86	[namespace code [list begin_resize %W %X %Y]]
87    bind StatusResize <B1-Motion> \
88	[namespace code [list continue_resize %W %X %Y]]
89    bind StatusResize <ButtonRelease-1> \
90	[namespace code [list end_resize %W %X %Y]]
91
92    bind StatusBar <Destroy> [list StatusBar::_destroy %W]
93
94    # PNG version has partial alpha transparency for better look
95    variable pngdata {
96	iVBORw0KGgoAAAANSUhEUgAAAA8AAAAPCAYAAAFM0aXcAAAABGdBTUEAAYagM
97	eiWXwAAAGJJREFUGJW9kVEOgCAMQzs8GEezN69fkKlbUAz2r3l5NGTA+pCU+Q
98	IA5sv39wGgZKClZGBhJMVTklRr3VNwMz04mVfQzQiEm79EkrYZycxIkq8kkv2
99	v6RFGku9TUrj8RGr9AGy6mhv2ymLwAAAAAElFTkSuQmCC
100    }
101    variable gifdata {
102	R0lGODlhDwAPAJEAANnZ2f///4CAgD8/PyH5BAEAAAAALAAAAAAPAA8AAAJEh
103	I+py+1IQvh4IZlG0Qg+QshkAokGQfAvZCBIhG8hA0Ea4UPIQJBG+BAyEKQhCH
104	bIQAgNEQCAIA0hAyE0AEIGgjSEDBQAOw==
105    }
106    if {[package provide img::png] != ""} {
107	image create photo ::StatusBar::resizer -format PNG -data $pngdata
108    } else {
109	image create photo ::StatusBar::resizer -format GIF -data $gifdata
110    }
111}
112
113
114# ------------------------------------------------------------------------
115#  Command StatusBar::create
116# ------------------------------------------------------------------------
117proc StatusBar::create { path args } {
118    variable _widget
119    variable HaveMarlett
120
121    # Allow for img::png loaded after initial source
122    if {[package provide img::png] != ""} {
123	variable pngdata
124	::StatusBar::resizer configure -format PNG -data $pngdata
125    }
126
127    Widget::init StatusBar $path $args
128
129    eval [list frame $path -class StatusBar] [Widget::subcget $path :cmd]
130
131    foreach {padx pady} [_padval [Widget::cget $path -pad]] \
132	{ipadx ipady} [_padval [Widget::cget $path -ipad]] { break }
133
134    if {[BWidget::using ttk]} {
135	set sbar   [ttk::frame $path.sbar -padding [list $padx $pady]]
136    } else {
137	set sbar   [eval [list frame $path.sbar -padx $padx -pady $pady] \
138			[Widget::subcget $path .sbar]]
139    }
140    if {[string equal $::tcl_platform(platform) "windows"]} {
141	set cursor size_nw_se
142    } else {
143	set cursor sizing; # bottom_right_corner ??
144    }
145    set resize [eval [list label $path.resize] \
146		    [Widget::subcget $path .resize] \
147		    [list -borderwidth 0 -relief flat -anchor se \
148			 -cursor $cursor -anchor se -padx 0 -pady 0]]
149    if {$HaveMarlett} {
150	$resize configure -font "Marlett -16" -text \u006f
151    } else {
152	$resize configure -image ::StatusBar::resizer
153    }
154    bindtags $resize [list all [winfo toplevel $path] StatusResize $resize]
155
156    if {[BWidget::using ttk]} {
157	set fsep [ttk::separator $path.hsep -orient horizontal]
158    } else {
159	set fsep [eval [list frame $path.hsep -bd 1 -height 2 -relief sunken] \
160		      [Widget::subcget $path .hsep]]
161    }
162    set sep  [_sep $path sepresize {}]
163
164    grid $fsep   -row 0 -column 0 -columnspan 3 -sticky ew
165    grid $sbar   -row 1 -column 0 -sticky news
166    grid $sep    -row 1 -column 1 -sticky ns -padx $ipadx -pady $ipady
167    grid $resize -row 1 -column 2 -sticky news
168    grid columnconfigure $path 0 -weight 1
169    if {![Widget::cget $path -showseparator]} {
170	grid remove $fsep
171    }
172    if {![Widget::cget $path -showresize]} {
173	grid remove $sep $resize
174    } elseif {![Widget::cget $path -showresizesep]} {
175	grid remove $sep
176    }
177    set _widget($path,items) {}
178
179    return [Widget::create StatusBar $path]
180}
181
182
183# ------------------------------------------------------------------------
184#  Command StatusBar::configure
185# ------------------------------------------------------------------------
186proc StatusBar::configure { path args } {
187    variable _widget
188
189    set res [Widget::configure $path $args]
190
191    foreach {chshow chshowrsep chshowsep chipad chpad} \
192	[Widget::hasChangedX $path -showresize -showresizesep -showseparator \
193	     -ipad -pad] { break }
194
195    if {$chshow} {
196	set show [Widget::cget $path -showresize]
197	set showrsep [Widget::cget $path -showresizesep]
198        if {$show} {
199	    if {$showrsep} {
200		grid $path.sepresize
201	    }
202	    grid $path.resize
203        } else {
204	    grid remove $path.sepresize $path.resize
205	}
206    }
207    if {$chshowsep} {
208        if {$show} {
209	    grid $path.hsep
210        } else {
211	    grid remove $path.hsep
212	}
213    }
214    if {$chipad} {
215	foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break }
216	foreach w [grid slaves $path.sbar] {
217	    grid configure $w -padx $ipadx -pady $ipady
218	}
219    }
220    if {$chpad} {
221	foreach {padx pady} [_padval [Widget::cget $path -pad]] { break }
222	if {[string equal [winfo class $path.sbar] "TFrame"]} {
223	    $path.sbar configure -padding [list $padx $pady]
224	} else {
225	    $path.sbar configure -padx $padx -pady $pady
226	}
227    }
228    return $res
229}
230
231
232# ------------------------------------------------------------------------
233#  Command StatusBar::cget
234# ------------------------------------------------------------------------
235proc StatusBar::cget { path option } {
236    return [Widget::cget $path $option]
237}
238
239# ------------------------------------------------------------------------
240#  Command StatusBar::getframe
241# ------------------------------------------------------------------------
242proc StatusBar::getframe {path} {
243    # This is the frame that users should place their statusbar widgets in
244    return $path.sbar
245}
246
247# ------------------------------------------------------------------------
248#  Command StatusBar::add
249# ------------------------------------------------------------------------
250proc StatusBar::add {path w args} {
251    variable _widget
252
253    array set opts [list \
254			-weight    0 \
255			-separator 1 \
256			-sticky    news \
257			-pad       [Widget::cget $path -ipad] \
258			]
259    foreach {key val} $args {
260	if {[info exists opts($key)]} {
261	    set opts($key) $val
262	} else {
263	    set msg "unknown option \"$key\", must be one of: "
264	    append msg [join [lsort [array names opts]] {, }]
265	    return -code error $msg
266	}
267    }
268    foreach {ipadx ipady} [_padval $opts(-pad)] { break }
269
270    set sbar $path.sbar
271    foreach {cols rows} [grid size $sbar] break
272    # Add separator if requested, and we aren't the first element
273    if {$opts(-separator) && $cols != 0} {
274	set sep [_sep $path sep[winfo name $w]]
275	# only append name, to distinguish us from them
276	lappend _widget($path,items) [winfo name $sep]
277	grid $sep -in $sbar -row 0 -column $cols \
278	    -sticky ns -padx $ipadx -pady $ipady
279	incr cols
280    }
281
282    lappend _widget($path,items) $w
283    grid $w -in $sbar -row 0 -column $cols -sticky $opts(-sticky) \
284	-padx $ipadx -pady $ipady
285    grid columnconfigure $sbar $cols -weight $opts(-weight)
286
287    return $w
288}
289
290# ------------------------------------------------------------------------
291#  Command StatusBar::delete
292# ------------------------------------------------------------------------
293proc StatusBar::remove {path args} {
294    variable _widget
295
296    set destroy [string equal [lindex $args 0] "-destroy"]
297    if {$destroy} {
298	set args [lrange $args 1 end]
299    }
300    foreach w $args {
301	set idx [lsearch -exact $_widget($path,items) $w]
302	if {$idx == -1 || ![winfo exists $w]} {
303	    # ignore unknown or non-widget items (like our separators)
304	    continue
305	}
306	# separator is always previous item
307	set sidx [expr {$idx - 1}]
308	set sep  [lindex $_widget($path,items) $sidx]
309	if {[string match .* $sep]} {
310	    # not one of our separators
311	    incr sidx
312	} elseif {$sep != ""} {
313	    # destroy separator too
314	    set sep $path.sbar.$sep
315	    destroy $sep
316	}
317	if {$destroy} {
318	    destroy $w
319	} else {
320	    grid forget $w
321	}
322	if {$idx == 0} {
323	    # separator of next item is no longer necessary
324	    set sep [lindex $_widget($path,items) [expr {$idx + 1}]]
325	    if {$sep != "" && ![string match .* $sep]} {
326		incr idx
327		set sep $path.sbar.$sep
328		destroy $sep
329	    }
330	}
331	set _widget($path,items) [lreplace $_widget($path,items) $sidx $idx]
332    }
333}
334
335# ------------------------------------------------------------------------
336#  Command StatusBar::delete
337# ------------------------------------------------------------------------
338proc StatusBar::delete {path args} {
339    return [StatusBar::remove $path -destroy $args]
340}
341
342# ------------------------------------------------------------------------
343#  Command StatusBar::items
344# ------------------------------------------------------------------------
345proc StatusBar::items {path} {
346    variable _widget
347    return $_widget($path,items)
348}
349
350proc StatusBar::_sep {path name {sub .sbar}} {
351    if {[BWidget::using ttk]} {
352	return [ttk::separator $path$sub.$name -orient vertical]
353    } else {
354	return [frame $path$sub.$name -bd 1 -width 2 -relief sunken]
355    }
356}
357
358proc StatusBar::_padval {padval} {
359    set len [llength $padval]
360    foreach {a b} $padval { break }
361    if {$len == 0 || $len > 2} {
362	return -code error \
363	    "invalid pad value \"$padval\", must be 1 or 2 pixel values"
364    } elseif {$len == 1} {
365	return [list $a $a]
366    } elseif {$len == 2} {
367	return $padval
368    }
369}
370
371# ------------------------------------------------------------------------
372#  Command StatusBar::_destroy
373# ------------------------------------------------------------------------
374proc StatusBar::_destroy { path } {
375    variable _widget
376    variable resize
377    array unset widget $path,*
378    array unset resize $path.resize,*
379    Widget::destroy $path
380}
381
382# The following proc handles the mouse click on the resize control. It stores
383# the original size of the window and the initial coords of the mouse relative
384# to the root.
385
386proc StatusBar::begin_resize {w rootx rooty} {
387    variable resize
388    set t    [winfo toplevel $w]
389    set relx [expr {$rootx - [winfo rootx $t]}]
390    set rely [expr {$rooty - [winfo rooty $t]}]
391    set resize($w,x) $relx
392    set resize($w,y) $rely
393    set resize($w,w) [winfo width $t]
394    set resize($w,h) [winfo height $t]
395    set resize($w,winc) 1
396    set resize($w,hinc) 1
397    set resize($w,grid) [wm grid $t]
398}
399
400# The following proc handles mouse motion on the resize control by asking the
401# wm to adjust the size of the window.
402
403proc StatusBar::continue_resize {w rootx rooty} {
404    variable resize
405    if {[llength $resize($w,grid)]} {
406	# at this time, we don't know how to handle gridded resizing
407	return
408    }
409    set t      [winfo toplevel $w]
410    set relx   [expr {$rootx - [winfo rootx $t]}]
411    set rely   [expr {$rooty - [winfo rooty $t]}]
412    set width  [expr {$relx - $resize($w,x) + $resize($w,w)}]
413    set height [expr {$rely - $resize($w,y) + $resize($w,h)}]
414    if {$width  < 0} { set width 0 }
415    if {$height < 0} { set height 0 }
416    wm geometry $t ${width}x${height}
417
418    if {[string equal $::tcl_platform(platform) "windows"]} {
419      update idletasks
420    }
421}
422
423# The following proc cleans up when the user releases the mouse button.
424
425proc StatusBar::end_resize {w rootx rooty} {
426    variable resize
427    #continue_resize $w $rootx $rooty
428    #wm grid $t $resize($w,grid)
429    array unset resize $w,*
430}
431