1#
2# Pushbutton
3# ----------------------------------------------------------------------
4# Implements a Motif-like Pushbutton with an optional default ring.
5#
6# WISH LIST:
7#    1)  Allow bitmaps and text on the same button face (Tk limitation).
8#    2)  provide arm and disarm bitmaps.
9#
10# ----------------------------------------------------------------------
11#   AUTHOR:  Mark L. Ulferts        EMAIL: mulferts@austin.dsccc.com
12#            Bret A. Schuhmacher    EMAIL: bas@wn.com
13#
14#   @(#) $Id: pushbutton.itk,v 1.4 2007/06/10 19:28:30 hobbs Exp $
15# ----------------------------------------------------------------------
16#            Copyright (c) 1995 DSC Technologies Corporation
17# ======================================================================
18# Permission to use, copy, modify, distribute and license this software
19# and its documentation for any purpose, and without fee or written
20# agreement with DSC, is hereby granted, provided that the above copyright
21# notice appears in all copies and that both the copyright notice and
22# warranty disclaimer below appear in supporting documentation, and that
23# the names of DSC Technologies Corporation or DSC Communications
24# Corporation not be used in advertising or publicity pertaining to the
25# software without specific, written prior permission.
26#
27# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
28# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
29# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
30# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
31# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
32# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
33# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
34# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
35# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
36# SOFTWARE.
37# ======================================================================
38
39#
40# Usual options.
41#
42itk::usual Pushbutton {
43    keep -activebackground -activeforeground -background -borderwidth \
44	 -cursor -disabledforeground -font -foreground -highlightbackground \
45	 -highlightcolor -highlightthickness
46}
47
48# ------------------------------------------------------------------
49#                            PUSHBUTTON
50# ------------------------------------------------------------------
51itcl::class iwidgets::Pushbutton {
52    inherit itk::Widget
53
54    constructor {args} {}
55    destructor {}
56
57    itk_option define -padx padX Pad 11
58    itk_option define -pady padY Pad 4
59    itk_option define -font font Font \
60	    -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
61    itk_option define -text text Text {}
62    itk_option define -bitmap bitmap Bitmap {}
63    itk_option define -image image Image {}
64    itk_option define -highlightthickness highlightThickness \
65	    HighlightThickness 2
66    itk_option define -borderwidth borderWidth BorderWidth 2
67    itk_option define -defaultring defaultRing DefaultRing 0
68    itk_option define -defaultringpad defaultRingPad Pad 4
69    itk_option define -height height Height 0
70    itk_option define -width width Width 0
71    itk_option define -takefocus takeFocus TakeFocus 0
72
73    public method flash {}
74    public method invoke {}
75
76    protected method _relayout {{when later}}
77    protected variable _reposition ""  ;# non-null => _relayout pending
78}
79
80#
81# Provide a lowercased access method for the Pushbutton class.
82#
83proc ::iwidgets::pushbutton {pathName args} {
84    uplevel ::iwidgets::Pushbutton $pathName $args
85}
86
87#
88# Use option database to override default resources of base classes.
89#
90option add *Pushbutton.borderWidth 2 widgetDefault
91
92# ------------------------------------------------------------------
93#                        CONSTRUCTOR
94# ------------------------------------------------------------------
95itcl::body iwidgets::Pushbutton::constructor {args} {
96    #
97    # Reconfigure the hull to act as the outer sunken ring of
98    # the pushbutton, complete with focus ring.
99    #
100    itk_option add hull.borderwidth hull.relief
101    itk_option add hull.highlightcolor
102    itk_option add hull.highlightbackground
103
104    if {$::tk_version > 8.3} {
105	# Tk 8.4+ frame -padx -pady options creates inadvertant margin box
106	component hull configure -padx 0 -pady 0 \
107	    -borderwidth [$this cget -borderwidth]
108    } else {
109	component hull configure -borderwidth [$this cget -borderwidth]
110    }
111
112    pack propagate $itk_component(hull) no
113
114    itk_component add pushbutton {
115	button $itk_component(hull).pushbutton \
116    } {
117        usual
118	keep -underline -wraplength -state -command
119    }
120    pack $itk_component(pushbutton) -expand 1 -fill both
121
122    #
123    # Initialize the widget based on the command line options.
124    #
125    eval itk_initialize $args
126
127    #
128    # Layout the pushbutton.
129    #
130    _relayout
131}
132
133# ------------------------------------------------------------------
134#                           DESTRUCTOR
135# ------------------------------------------------------------------
136itcl::body iwidgets::Pushbutton::destructor {} {
137    if {$_reposition != ""} {after cancel $_reposition}
138}
139
140# ------------------------------------------------------------------
141#                             OPTIONS
142# ------------------------------------------------------------------
143
144# ------------------------------------------------------------------
145# OPTION: -padx
146#
147# Specifies the extra space surrounding the label in the x direction.
148# ------------------------------------------------------------------
149itcl::configbody iwidgets::Pushbutton::padx {
150    $itk_component(pushbutton) configure -padx $itk_option(-padx)
151
152    _relayout
153}
154
155# ------------------------------------------------------------------
156# OPTION: -pady
157#
158# Specifies the extra space surrounding the label in the y direction.
159# ------------------------------------------------------------------
160itcl::configbody iwidgets::Pushbutton::pady {
161    $itk_component(pushbutton) configure -pady $itk_option(-pady)
162
163    _relayout
164}
165
166# ------------------------------------------------------------------
167# OPTION: -font
168#
169# Specifies the label font.
170# ------------------------------------------------------------------
171itcl::configbody iwidgets::Pushbutton::font {
172    $itk_component(pushbutton) configure -font $itk_option(-font)
173
174    _relayout
175}
176
177# ------------------------------------------------------------------
178# OPTION: -text
179#
180# Specifies the label text.
181# ------------------------------------------------------------------
182itcl::configbody iwidgets::Pushbutton::text {
183    $itk_component(pushbutton) configure -text $itk_option(-text)
184
185    _relayout
186}
187
188# ------------------------------------------------------------------
189# OPTION: -bitmap
190#
191# Specifies the label bitmap.
192# ------------------------------------------------------------------
193itcl::configbody iwidgets::Pushbutton::bitmap {
194    $itk_component(pushbutton) configure -bitmap $itk_option(-bitmap)
195
196    _relayout
197}
198
199# ------------------------------------------------------------------
200# OPTION: -image
201#
202# Specifies the label image.
203# ------------------------------------------------------------------
204itcl::configbody iwidgets::Pushbutton::image {
205    $itk_component(pushbutton) configure -image $itk_option(-image)
206
207    _relayout
208}
209
210# ------------------------------------------------------------------
211# OPTION: -highlightthickness
212#
213# Specifies the thickness of the highlight ring.
214# ------------------------------------------------------------------
215itcl::configbody iwidgets::Pushbutton::highlightthickness {
216    $itk_component(pushbutton) configure \
217	    -highlightthickness $itk_option(-highlightthickness)
218
219    _relayout
220}
221
222# ------------------------------------------------------------------
223# OPTION: -borderwidth
224#
225# Specifies the width of the relief border.
226# ------------------------------------------------------------------
227itcl::configbody iwidgets::Pushbutton::borderwidth {
228    $itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth)
229
230    _relayout
231}
232
233# ------------------------------------------------------------------
234# OPTION: -defaultring
235#
236# Boolean describing whether the button displays its default ring.
237# ------------------------------------------------------------------
238itcl::configbody iwidgets::Pushbutton::defaultring {
239    _relayout
240}
241
242# ------------------------------------------------------------------
243# OPTION: -defaultringpad
244#
245# The size of the padded default ring around the button.
246# ------------------------------------------------------------------
247itcl::configbody iwidgets::Pushbutton::defaultringpad {
248    pack $itk_component(pushbutton) \
249	    -padx $itk_option(-defaultringpad) \
250	    -pady $itk_option(-defaultringpad)
251}
252
253# ------------------------------------------------------------------
254# OPTION: -height
255#
256# Specifies the height of the button inclusive of any default ring.
257# A value of zero lets the push button determine the height based
258# on the requested height plus highlightring and defaultringpad.
259# ------------------------------------------------------------------
260itcl::configbody iwidgets::Pushbutton::height {
261    _relayout
262}
263
264# ------------------------------------------------------------------
265# OPTION: -width
266#
267# Specifies the width of the button inclusive of any default ring.
268# A value of zero lets the push button determine the width based
269# on the requested width plus highlightring and defaultringpad.
270# ------------------------------------------------------------------
271itcl::configbody iwidgets::Pushbutton::width {
272    _relayout
273}
274
275# ------------------------------------------------------------------
276#                            METHODS
277# ------------------------------------------------------------------
278
279# ------------------------------------------------------------------
280# METHOD: flash
281#
282# Thin wrap of standard button widget flash method.
283# ------------------------------------------------------------------
284itcl::body iwidgets::Pushbutton::flash {} {
285    $itk_component(pushbutton) flash
286}
287
288# ------------------------------------------------------------------
289# METHOD: invoke
290#
291# Thin wrap of standard button widget invoke method.
292# ------------------------------------------------------------------
293itcl::body iwidgets::Pushbutton::invoke {} {
294    $itk_component(pushbutton) invoke
295}
296
297# ------------------------------------------------------------------
298# PROTECTED METHOD: _relayout ?when?
299#
300# Adjust the width and height of the Pushbutton to accomadate all the
301# current options settings.  Add back in the highlightthickness to
302# the button such that the correct reqwidth and reqheight are computed.
303# Set the width and height based on the reqwidth/reqheight,
304# highlightthickness, and ringpad.  Finally, configure the defaultring
305# properly. If "when" is "now", the change is applied immediately.  If
306# it is "later" or it is not specified, then the change is applied later,
307# when the application is idle.
308# ------------------------------------------------------------------
309itcl::body iwidgets::Pushbutton::_relayout {{when later}} {
310    if {$when == "later"} {
311	if {$_reposition == ""} {
312	    set _reposition [after idle [itcl::code $this _relayout now]]
313	}
314	return
315    } elseif {$when != "now"} {
316	error "bad option \"$when\": should be now or later"
317    }
318
319    set _reposition ""
320
321    if {$itk_option(-width) == 0} {
322	set w [expr {[winfo reqwidth $itk_component(pushbutton)] \
323		+ 2 * $itk_option(-highlightthickness) \
324		+ 2 * $itk_option(-borderwidth) \
325		+ 2 * $itk_option(-defaultringpad)}]
326    } else {
327	set w $itk_option(-width)
328    }
329
330    if {$itk_option(-height) == 0} {
331	set h [expr {[winfo reqheight $itk_component(pushbutton)] \
332		+ 2 * $itk_option(-highlightthickness) \
333		+ 2 * $itk_option(-borderwidth) \
334		+ 2 * $itk_option(-defaultringpad)}]
335    } else {
336	set h $itk_option(-height)
337    }
338
339    component hull configure -width $w -height $h
340
341    if {$itk_option(-defaultring)} {
342	component hull configure -relief sunken \
343		-highlightthickness [$this cget -highlightthickness] \
344		-takefocus 1
345
346	configure -takefocus 1
347
348	component pushbutton configure \
349		-highlightthickness 0 -takefocus 0
350
351    } else {
352	component hull configure -relief flat \
353		-highlightthickness 0 -takefocus 0
354
355	component pushbutton configure \
356		-highlightthickness [$this cget -highlightthickness] \
357		-takefocus 1
358
359	configure -takefocus 0
360    }
361}
362