1#
2# $RCSfile: optionmenuhelp.itcl,v $ --
3#
4#      This file contains the "optionmenuhelp megawidget implementation.
5#
6# Copyright (c) 2003--2004 Anton Kokalj   Email: tone.kokalj@ijs.si
7#
8#
9# This file is distributed under the terms of the GNU General Public
10# License. See the file `COPYING' in the root directory of the present
11# distribution, or http://www.gnu.org/copyleft/gpl.txt .
12#
13#
14# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
15# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17# ANTON KOKALJ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
18# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
19# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
20#
21#
22# $Id: optionmenuhelp.itcl,v 1.5 2008-05-08 18:44:36 kokalj Exp $
23#
24
25
26option add *Optionmenuhelp.menubackground    Gray    widgetDefault
27
28# ------------------------------------------------------------------------
29#  USUAL options.
30# ------------------------------------------------------------------------
31itk::usual ::guib::widgets::Optionmenuhelp {
32    keep -activebackground -activeborderwidth -activeforeground \
33	 -background -borderwidth -cursor -disabledforeground -font \
34	 -foreground -highlightcolor -highlightthickness -labelfont \
35	 -popupcursor
36}
37
38
39# ------------------------------------------------------------------
40#  OPTIONMENUHELP
41# ------------------------------------------------------------------
42#****f* widgets/optionmenuhelp
43#  NAME
44#    ::guib::widgets::optionmenuhelp -- optionmenuhelp megawidget
45#  USAGE
46#    optionmenuhelp pathName ?option value?  ?...?
47#  DESCRIPTION
48#    optionmenuhelp = optionmenu + help-button
49#  OPTIONS
50#    Special OPTIONS
51#      -textvariable
52#      -textvalues
53#      -state
54#      -width
55#      -borderwidth
56#      -highlightthickness
57#      -helpcommand -- command for the help button
58#      -helppadx    -- "padx" for the help button
59#      -helppady    -- "pady" for the help button
60#      -nohelp      -- display help button (true|false)
61#  METHODS
62#    Widget METHODS
63#      (see Optionmenuhelp documentation)
64#  RETURN VALUE
65#    Returns the path of the optionmenuhelp, i.e., pathName.
66#********
67# ------------------------------------------------------------------------
68proc ::guib::widgets::optionmenuhelp {pathName args} {
69    uplevel ::guib::widgets::Optionmenuhelp $pathName $args
70}
71# ------------------------------------------------------------------------
72#****c* widgets/Optionmenuhelp
73# NAME
74#    ::guib::widgets::Optionmenuhelp -- a class for optionmenuhelp megawidget
75# METHODS
76#   Public METHODS
77#    insert
78#    selected
79#****
80# ------------------------------------------------------------------------
81itcl::class ::guib::widgets::Optionmenuhelp {
82    inherit iwidgets::Labeledwidget
83
84    private variable _textvariable
85    private variable _items
86
87    constructor {args} {}
88    destructor {}
89
90    # define methods ...
91    public method insert   {index string args}
92    public method selected {}
93
94    private   method _additems   {items}
95    protected method _selectitem {item}
96    protected method _traceTextvariable {name1 name2 op}
97
98    itk_option define -textvariable textvariable TextVariable _textvariable
99    itk_option define -textvalues   textvalues   Textvalues   {}
100    itk_option define -state        state        State        normal
101    itk_option define -width        width        Width        0
102    itk_option define -borderwidth  borderWidth  BorderWidth  2
103    itk_option define -highlightthickness highlightThickness HighlightThickness 1
104    itk_option define -nohelp       nohelp       NoHelp       0
105    eval $::guib::widgets::def(helpCommand)
106}
107
108
109# ------------------------------------------------------------------
110#                        CONSTRUCTOR
111# ------------------------------------------------------------------
112itcl::body ::guib::widgets::Optionmenuhelp::constructor {args} {
113    global tcl_platform
114
115    component hull configure -highlightthickness 0
116
117    itk_component add menuBtn {
118	menubutton $itk_interior.menuBtn \
119	    -menu         $itk_interior.menuBtn.menu \
120	    -indicatoron  1 \
121	    -relief       raised
122    } {
123	usual
124	rename -background   -menubackground   menuBackground   Background
125    }
126    itk_component add popupMenu {
127	menu $itk_interior.menuBtn.menu -tearoff no
128    } {
129	usual
130	rename -background   -menubackground   menuBackground   Background
131	ignore -tearoff
132    }
133    itk_component add help {
134	button $itk_interior.help
135    } {
136	usual
137	eval $::guib::widgets::def(helpOptions)
138    }
139
140    #
141    # Initialize the widget based on the command line options.
142    #
143    eval itk_initialize $args
144    pack $itk_component(menuBtn) -side left -fill x -expand 1
145    if { ! $itk_option(-nohelp) } {
146	pack $itk_component(help) -side left \
147	    -padx $itk_option(-helppadx) -pady $itk_option(-helppady)
148    }
149
150    if { $itk_option(-textvariable) != {} } {
151	upvar $itk_option(-textvariable) textvarValue
152	set _textvariable $textvarValue
153	$itk_component(menuBtn) configure -textvariable $itk_option(-textvariable)
154    }
155}
156
157# ------------------------------------------------------------------
158# METHOD: insert index string ?string?
159#
160# Insert an item in the popup menu.
161# ------------------------------------------------------------------
162itcl::body ::guib::widgets::Optionmenuhelp::insert {index string args} {
163    set args  [linsert $args 0 $string]
164    _additems $args
165    return ""
166}
167itcl::body ::guib::widgets::Optionmenuhelp::selected {} {
168    return $_textvariable
169}
170
171itcl::body ::guib::widgets::Optionmenuhelp::_additems {items} {
172    foreach item $items {
173	$itk_component(popupMenu) add command -label $item \
174	    -command [code $this _selectitem $item]
175    }
176}
177
178itcl::body ::guib::widgets::Optionmenuhelp::_selectitem {item} {
179    set $itk_option(-textvariable) $item
180    set _textvariable $item
181}
182
183itcl::body ::guib::widgets::Optionmenuhelp::_traceTextvariable {name1 name2 op} {
184    upvar $itk_option(-textvariable) textVarname
185    #trace vdelete $itk_option(-textvariable) w [code $this _traceTextvariable]
186    set _textvariable $textVarname
187    #trace variable $itk_option(-textvariable) w [code $this _traceTextvariable]
188}
189
190
191itcl::configbody ::guib::widgets::Optionmenuhelp::nohelp {
192
193    if { ! [winfo ismapped $itk_interior.menuBtn] } {
194	return
195    }
196
197    if { $itk_option(-nohelp) } {
198	if { [winfo ismapped $itk_interior.help] } {
199	    pack forget $itk_interior.help
200	}
201    } else {
202	if { ! [winfo ismapped $itk_interior.help] } {
203	    pack $itk_interior.help -side left -padx $itk_option(-helppadx) -pady $itk_option(-helppady)
204	}
205    }
206}
207
208
209itcl::configbody ::guib::widgets::Optionmenuhelp::textvariable {
210    trace variable $itk_option(-textvariable) w [code $this _traceTextvariable]
211}
212
213itcl::configbody ::guib::widgets::Optionmenuhelp::textvalues {
214    upvar $itk_option(-textvariable) textvarValue
215
216    # by this option we delete the previous optionmenu entries
217    # and add new one ...
218    $itk_component(popupMenu) delete 0 end
219
220    # check if $_textvariable has allowed value
221    #if { [lsearch -exact $itk_option(-textvalues) $textvarValue] < 0 } {
222    #	value is not allowed
223    #	$this _selectitem ""
224    #}
225
226    _additems $itk_option(-textvalues)
227}
228
229itcl::configbody ::guib::widgets::Optionmenuhelp::state {
230    switch -exact -- $itk_option(-state) {
231	active -
232	normal {
233	    #::tku::enableAll $itk_component(hull)
234	    #::tku::enableAll $itk_component(label)
235	    ::tku::enableAll $itk_component(menuBtn)
236	    ::tku::enableAll $itk_component(popupMenu)
237	}
238	disabled {
239	    #::tku::disableAll $itk_component(hull)
240	    #::tku::disableAll $itk_component(label)
241	    ::tku::disableAll $itk_component(menuBtn)
242	    ::tku::disableAll $itk_component(popupMenu)
243	}
244	default {
245	    error "wrong value of -state option \"$itk_option(-state)\", should be normal, active, or disabled"
246	}
247    }
248}
249