1# Dialogshell 2# ---------------------------------------------------------------------- 3# This class is implements a dialog shell which is a top level widget 4# composed of a button box, separator, and child site area. The class 5# also has methods to control button construction. 6# 7# ---------------------------------------------------------------------- 8# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com 9# 10# @(#) $Id: dialogshell.itk,v 1.3 2001/08/15 18:32:02 smithc Exp $ 11# ---------------------------------------------------------------------- 12# Copyright (c) 1995 DSC Technologies Corporation 13# ====================================================================== 14# Permission to use, copy, modify, distribute and license this software 15# and its documentation for any purpose, and without fee or written 16# agreement with DSC, is hereby granted, provided that the above copyright 17# notice appears in all copies and that both the copyright notice and 18# warranty disclaimer below appear in supporting documentation, and that 19# the names of DSC Technologies Corporation or DSC Communications 20# Corporation not be used in advertising or publicity pertaining to the 21# software without specific, written prior permission. 22# 23# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 24# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 25# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 26# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 27# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 28# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 29# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 30# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 31# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 32# SOFTWARE. 33# ====================================================================== 34 35# 36# Usual options. 37# 38itk::usual Dialogshell { 39 keep -background -cursor -foreground -modality 40} 41 42# ------------------------------------------------------------------ 43# DIALOGSHELL 44# ------------------------------------------------------------------ 45itcl::class iwidgets::Dialogshell { 46 inherit iwidgets::Shell 47 48 constructor {args} {} 49 50 itk_option define -thickness thickness Thickness 3 51 itk_option define -buttonboxpos buttonBoxPos Position s 52 itk_option define -separator separator Separator on 53 itk_option define -padx padX Pad 10 54 itk_option define -pady padY Pad 10 55 56 public method childsite {} 57 public method index {args} 58 public method add {args} 59 public method insert {args} 60 public method delete {args} 61 public method hide {args} 62 public method show {args} 63 public method default {args} 64 public method invoke {args} 65 public method buttonconfigure {args} 66 public method buttoncget {index option} 67} 68 69# 70# Provide a lowercased access method for the Dialogshell class. 71# 72proc ::iwidgets::dialogshell {pathName args} { 73 uplevel ::iwidgets::Dialogshell $pathName $args 74} 75 76# 77# Use option database to override default resources of base classes. 78# 79option add *Dialogshell.master "." widgetDefault 80 81# ------------------------------------------------------------------ 82# CONSTRUCTOR 83# ------------------------------------------------------------------ 84itcl::body iwidgets::Dialogshell::constructor {args} { 85 itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady 86 87 # 88 # Create the user child site, separator, and button box, 89 # 90 itk_component add -protected dschildsite { 91 frame $itk_interior.dschildsite 92 } 93 94 itk_component add separator { 95 frame $itk_interior.separator -relief sunken 96 } 97 98 itk_component add bbox { 99 iwidgets::Buttonbox $itk_interior.bbox 100 } { 101 usual 102 103 rename -padx -buttonboxpadx buttonBoxPadX Pad 104 rename -pady -buttonboxpady buttonBoxPadY Pad 105 } 106 107 # 108 # Set the itk_interior variable to be the childsite for derived 109 # classes. 110 # 111 set itk_interior $itk_component(dschildsite) 112 113 # 114 # Set up the default button so that if <Return> is pressed in 115 # any widget, it will invoke the default button. 116 # 117 bind $itk_component(hull) <Return> [itcl::code $this invoke] 118 119 # 120 # Initialize the widget based on the command line options. 121 # 122 eval itk_initialize $args 123} 124 125# ------------------------------------------------------------------ 126# OPTIONS 127# ------------------------------------------------------------------ 128 129# ------------------------------------------------------------------ 130# OPTION: -thickness 131# 132# Specifies the thickness of the separator. It sets the width and 133# height of the separator to the thickness value and the borderwidth 134# to half the thickness. 135# ------------------------------------------------------------------ 136itcl::configbody iwidgets::Dialogshell::thickness { 137 $itk_component(separator) config -height $itk_option(-thickness) 138 $itk_component(separator) config -width $itk_option(-thickness) 139 $itk_component(separator) config \ 140 -borderwidth [expr {$itk_option(-thickness) / 2}] 141} 142 143# ------------------------------------------------------------------ 144# OPTION: -buttonboxpos 145# 146# Specifies the position of the button box relative to the child site. 147# The separator appears between the child site and button box. 148# ------------------------------------------------------------------ 149itcl::configbody iwidgets::Dialogshell::buttonboxpos { 150 set parent [winfo parent $itk_component(bbox)] 151 152 switch $itk_option(-buttonboxpos) { 153 n { 154 $itk_component(bbox) configure -orient horizontal 155 156 grid $itk_component(bbox) -row 0 -column 0 -sticky ew 157 grid $itk_component(separator) -row 1 -column 0 -sticky ew 158 grid $itk_component(dschildsite) -row 2 -column 0 -sticky nsew 159 160 grid rowconfigure $parent 0 -weight 0 161 grid rowconfigure $parent 1 -weight 0 162 grid rowconfigure $parent 2 -weight 1 163 grid columnconfigure $parent 0 -weight 1 164 grid columnconfigure $parent 1 -weight 0 165 grid columnconfigure $parent 2 -weight 0 166 } 167 s { 168 $itk_component(bbox) configure -orient horizontal 169 170 grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew 171 grid $itk_component(separator) -row 1 -column 0 -sticky ew 172 grid $itk_component(bbox) -row 2 -column 0 -sticky ew 173 174 grid rowconfigure $parent 0 -weight 1 175 grid rowconfigure $parent 1 -weight 0 176 grid rowconfigure $parent 2 -weight 0 177 grid columnconfigure $parent 0 -weight 1 178 grid columnconfigure $parent 1 -weight 0 179 grid columnconfigure $parent 2 -weight 0 180 } 181 w { 182 $itk_component(bbox) configure -orient vertical 183 184 grid $itk_component(bbox) -row 0 -column 0 -sticky ns 185 grid $itk_component(separator) -row 0 -column 1 -sticky ns 186 grid $itk_component(dschildsite) -row 0 -column 2 -sticky nsew 187 188 grid rowconfigure $parent 0 -weight 1 189 grid rowconfigure $parent 1 -weight 0 190 grid rowconfigure $parent 2 -weight 0 191 grid columnconfigure $parent 0 -weight 0 192 grid columnconfigure $parent 1 -weight 0 193 grid columnconfigure $parent 2 -weight 1 194 } 195 e { 196 $itk_component(bbox) configure -orient vertical 197 198 grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew 199 grid $itk_component(separator) -row 0 -column 1 -sticky ns 200 grid $itk_component(bbox) -row 0 -column 2 -sticky ns 201 202 grid rowconfigure $parent 0 -weight 1 203 grid rowconfigure $parent 1 -weight 0 204 grid rowconfigure $parent 2 -weight 0 205 grid columnconfigure $parent 0 -weight 1 206 grid columnconfigure $parent 1 -weight 0 207 grid columnconfigure $parent 2 -weight 0 208 } 209 default { 210 error "bad buttonboxpos option\ 211 \"$itk_option(-buttonboxpos)\": should be n,\ 212 s, e, or w" 213 } 214 } 215} 216 217# ------------------------------------------------------------------ 218# OPTION: -separator 219# 220# Boolean option indicating wheather to display the separator. 221# ------------------------------------------------------------------ 222itcl::configbody iwidgets::Dialogshell::separator { 223 if {$itk_option(-separator)} { 224 $itk_component(separator) configure -relief sunken 225 } else { 226 $itk_component(separator) configure -relief flat 227 } 228} 229 230# ------------------------------------------------------------------ 231# OPTION: -padx 232# 233# Specifies a padding distance for the childsite in the X-direction. 234# ------------------------------------------------------------------ 235itcl::configbody iwidgets::Dialogshell::padx { 236 grid configure $itk_component(dschildsite) -padx $itk_option(-padx) 237} 238 239# ------------------------------------------------------------------ 240# OPTION: -pady 241# 242# Specifies a padding distance for the childsite in the Y-direction. 243# ------------------------------------------------------------------ 244itcl::configbody iwidgets::Dialogshell::pady { 245 grid configure $itk_component(dschildsite) -pady $itk_option(-pady) 246} 247 248# ------------------------------------------------------------------ 249# METHODS 250# ------------------------------------------------------------------ 251 252# ------------------------------------------------------------------ 253# METHOD: childsite 254# 255# Return the pathname of the user accessible area. 256# ------------------------------------------------------------------ 257itcl::body iwidgets::Dialogshell::childsite {} { 258 return $itk_component(dschildsite) 259} 260 261# ------------------------------------------------------------------ 262# METHOD: index index 263# 264# Thin wrapper of Buttonbox's index method. 265# ------------------------------------------------------------------ 266itcl::body iwidgets::Dialogshell::index {args} { 267 uplevel $itk_component(bbox) index $args 268} 269 270# ------------------------------------------------------------------ 271# METHOD: add tag ?option value ...? 272# 273# Thin wrapper of Buttonbox's add method. 274# ------------------------------------------------------------------ 275itcl::body iwidgets::Dialogshell::add {args} { 276 uplevel $itk_component(bbox) add $args 277} 278 279# ------------------------------------------------------------------ 280# METHOD: insert index tag ?option value ...? 281# 282# Thin wrapper of Buttonbox's insert method. 283# ------------------------------------------------------------------ 284itcl::body iwidgets::Dialogshell::insert {args} { 285 uplevel $itk_component(bbox) insert $args 286} 287 288# ------------------------------------------------------------------ 289# METHOD: delete tag 290# 291# Thin wrapper of Buttonbox's delete method. 292# ------------------------------------------------------------------ 293itcl::body iwidgets::Dialogshell::delete {args} { 294 uplevel $itk_component(bbox) delete $args 295} 296 297# ------------------------------------------------------------------ 298# METHOD: hide index 299# 300# Thin wrapper of Buttonbox's hide method. 301# ------------------------------------------------------------------ 302itcl::body iwidgets::Dialogshell::hide {args} { 303 uplevel $itk_component(bbox) hide $args 304} 305 306# ------------------------------------------------------------------ 307# METHOD: show index 308# 309# Thin wrapper of Buttonbox's show method. 310# ------------------------------------------------------------------ 311itcl::body iwidgets::Dialogshell::show {args} { 312 uplevel $itk_component(bbox) show $args 313} 314 315# ------------------------------------------------------------------ 316# METHOD: default index 317# 318# Thin wrapper of Buttonbox's default method. 319# ------------------------------------------------------------------ 320itcl::body iwidgets::Dialogshell::default {args} { 321 uplevel $itk_component(bbox) default $args 322} 323 324# ------------------------------------------------------------------ 325# METHOD: invoke ?index? 326# 327# Thin wrapper of Buttonbox's invoke method. 328# ------------------------------------------------------------------ 329itcl::body iwidgets::Dialogshell::invoke {args} { 330 uplevel $itk_component(bbox) invoke $args 331} 332 333# ------------------------------------------------------------------ 334# METHOD: buttonconfigure index ?option? ?value option value ...? 335# 336# Thin wrapper of Buttonbox's buttonconfigure method. 337# ------------------------------------------------------------------ 338itcl::body iwidgets::Dialogshell::buttonconfigure {args} { 339 uplevel $itk_component(bbox) buttonconfigure $args 340} 341 342# ------------------------------------------------------------------ 343# METHOD: buttoncget index option 344# 345# Thin wrapper of Buttonbox's buttoncget method. 346# ------------------------------------------------------------------ 347itcl::body iwidgets::Dialogshell::buttoncget {index option} { 348 uplevel $itk_component(bbox) buttoncget [list $index] \ 349 [list $option] 350} 351