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