1# ---------------------------------------------------------------------------- 2# dialog.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: dialog.tcl,v 1.15.2.1 2010/08/04 13:07:59 oehhar Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - Dialog::create 8# - Dialog::configure 9# - Dialog::cget 10# - Dialog::getframe 11# - Dialog::add 12# - Dialog::itemconfigure 13# - Dialog::itemcget 14# - Dialog::invoke 15# - Dialog::setfocus 16# - Dialog::enddialog 17# - Dialog::draw 18# - Dialog::withdraw 19# - Dialog::_destroy 20# ---------------------------------------------------------------------------- 21 22# JDC: added -transient and -place flag 23 24namespace eval Dialog { 25 Widget::define Dialog dialog ButtonBox 26 27 Widget::bwinclude Dialog ButtonBox .bbox \ 28 remove {-orient} \ 29 initialize {-spacing 10 -padx 10} 30 31 Widget::declare Dialog { 32 {-title String "" 0} 33 {-geometry String "" 0} 34 {-modal Enum local 0 {none local global}} 35 {-bitmap TkResource "" 1 label} 36 {-image TkResource "" 1 label} 37 {-separator Boolean 0 1} 38 {-cancel Int -1 0 "%d >= -1"} 39 {-parent String "" 0} 40 {-side Enum bottom 1 {bottom left top right}} 41 {-anchor Enum c 1 {n e w s c}} 42 {-class String Dialog 1} 43 {-transient Boolean 1 1} 44 {-place Enum center 0 {none center left right above below}} 45 } 46 47 Widget::addmap Dialog "" :cmd {-background {}} 48 Widget::addmap Dialog "" .frame {-background {}} 49 50 bind BwDialog <Destroy> [list Dialog::_destroy %W] 51 52 variable _widget 53} 54 55 56# ---------------------------------------------------------------------------- 57# Command Dialog::create 58# ---------------------------------------------------------------------------- 59proc Dialog::create { path args } { 60 global tcl_platform 61 variable _widget 62 63 array set maps [list Dialog {} .bbox {}] 64 array set maps [Widget::parseArgs Dialog $args] 65 66 # Check to see if the -class flag was specified 67 set dialogClass "Dialog" 68 array set dialogArgs $maps(Dialog) 69 if { [info exists dialogArgs(-class)] } { 70 set dialogClass $dialogArgs(-class) 71 } 72 73 if { [string equal $tcl_platform(platform) "unix"] } { 74 set re raised 75 set bd 1 76 } else { 77 set re flat 78 set bd 0 79 } 80 toplevel $path -relief $re -borderwidth $bd -class $dialogClass 81 wm withdraw $path 82 83 Widget::initFromODB Dialog $path $maps(Dialog) 84 85 bindtags $path [list $path BwDialog all] 86 wm overrideredirect $path 1 87 wm title $path [Widget::cget $path -title] 88 set parent [Widget::cget $path -parent] 89 if { ![winfo exists $parent] } { 90 set parent [winfo parent $path] 91 } 92 # JDC: made transient optional 93 if { [Widget::getoption $path -transient] } { 94 wm transient $path [winfo toplevel $parent] 95 } 96 97 set side [Widget::cget $path -side] 98 if { [string equal $side "left"] || [string equal $side "right"] } { 99 set orient vertical 100 } else { 101 set orient horizontal 102 } 103 104 set bbox [eval [list ButtonBox::create $path.bbox] $maps(.bbox) \ 105 -orient $orient] 106 set frame [frame $path.frame -relief flat -borderwidth 0] 107 set bg [Widget::cget $path -background] 108 $path configure -background $bg 109 $frame configure -background $bg 110 if { [set bitmap [Widget::getoption $path -image]] != "" } { 111 set label [label $path.label -image $bitmap -background $bg] 112 } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } { 113 set label [label $path.label -bitmap $bitmap -background $bg] 114 } 115 if { [Widget::getoption $path -separator] } { 116 Separator::create $path.sep -orient $orient -background $bg 117 } 118 set _widget($path,realized) 0 119 set _widget($path,nbut) 0 120 121 set cancel [Widget::getoption $path -cancel] 122 bind $path <Escape> [list ButtonBox::invoke $path.bbox $cancel] 123 if {$cancel != -1} { 124 wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel] 125 } 126 bind $path <Return> [list ButtonBox::invoke $path.bbox default] 127 # Tk8.5 (TIP158) separated numeric keyboard enter and main keyboard 128 # enter on Unix. So bind for both. This does not harm on Tk8.4 so no 129 # check required. BWidget Ticket [3e31f04367]. 130 bind $path <KP_Enter> [list ButtonBox::invoke $path.bbox default] 131 132 return [Widget::create Dialog $path] 133} 134 135 136# ---------------------------------------------------------------------------- 137# Command Dialog::configure 138# ---------------------------------------------------------------------------- 139proc Dialog::configure { path args } { 140 set res [Widget::configure $path $args] 141 142 if { [Widget::hasChanged $path -title title] } { 143 wm title $path $title 144 } 145 if { [Widget::hasChanged $path -background bg] } { 146 if { [winfo exists $path.label] } { 147 $path.label configure -background $bg 148 } 149 if { [winfo exists $path.sep] } { 150 Separator::configure $path.sep -background $bg 151 } 152 } 153 if { [Widget::hasChanged $path -cancel cancel] } { 154 bind $path <Escape> [list ButtonBox::invoke $path.bbox $cancel] 155 if {$cancel == -1} { 156 wm protocol $path WM_DELETE_WINDOW "" 157 } else { 158 wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel] 159 } 160 } 161 return $res 162} 163 164 165# ---------------------------------------------------------------------------- 166# Command Dialog::cget 167# ---------------------------------------------------------------------------- 168proc Dialog::cget { path option } { 169 return [Widget::cget $path $option] 170} 171 172 173# ---------------------------------------------------------------------------- 174# Command Dialog::getframe 175# ---------------------------------------------------------------------------- 176proc Dialog::getframe { path } { 177 return $path.frame 178} 179 180 181# ---------------------------------------------------------------------------- 182# Command Dialog::add 183# ---------------------------------------------------------------------------- 184proc Dialog::add { path args } { 185 variable _widget 186 187 if {[string equal $::tcl_platform(platform) "windows"] 188 && $::tk_version >= 8.4} { 189 set width -11 190 } else { 191 set width 8 192 } 193 set cmd [list ButtonBox::add $path.bbox -width $width \ 194 -command [list Dialog::enddialog $path $_widget($path,nbut)]] 195 set res [eval $cmd $args] 196 incr _widget($path,nbut) 197 return $res 198} 199 200 201# ---------------------------------------------------------------------------- 202# Command Dialog::itemconfigure 203# ---------------------------------------------------------------------------- 204proc Dialog::itemconfigure { path index args } { 205 return [eval [list ButtonBox::itemconfigure $path.bbox $index] $args] 206} 207 208 209# ---------------------------------------------------------------------------- 210# Command Dialog::itemcget 211# ---------------------------------------------------------------------------- 212proc Dialog::itemcget { path index option } { 213 return [ButtonBox::itemcget $path.bbox $index $option] 214} 215 216 217# ---------------------------------------------------------------------------- 218# Command Dialog::invoke 219# ---------------------------------------------------------------------------- 220proc Dialog::invoke { path index } { 221 ButtonBox::invoke $path.bbox $index 222} 223 224 225# ---------------------------------------------------------------------------- 226# Command Dialog::setfocus 227# ---------------------------------------------------------------------------- 228proc Dialog::setfocus { path index } { 229 ButtonBox::setfocus $path.bbox $index 230} 231 232 233# ---------------------------------------------------------------------------- 234# Command Dialog::enddialog 235# ---------------------------------------------------------------------------- 236proc Dialog::enddialog { path result } { 237 variable _widget 238 239 set _widget($path,result) $result 240} 241 242 243# ---------------------------------------------------------------------------- 244# Command Dialog::draw 245# ---------------------------------------------------------------------------- 246proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} { 247 variable _widget 248 249 set parent [Widget::getoption $path -parent] 250 if { !$_widget($path,realized) } { 251 set _widget($path,realized) 1 252 if { [llength [winfo children $path.bbox]] } { 253 set side [Widget::getoption $path -side] 254 if {[string equal $side "left"] || [string equal $side "right"]} { 255 set pad -padx 256 set fill y 257 } else { 258 set pad -pady 259 set fill x 260 } 261 pack $path.bbox -side $side -padx 1m -pady 1m \ 262 -anchor [Widget::getoption $path -anchor] 263 if { [winfo exists $path.sep] } { 264 pack $path.sep -side $side -fill $fill $pad 2m 265 } 266 } 267 if { [winfo exists $path.label] } { 268 pack $path.label -side left -anchor n -padx 3m -pady 3m 269 } 270 pack $path.frame -padx 1m -pady 1m -fill both -expand yes 271 } 272 273 set geom [Widget::getMegawidgetOption $path -geometry] 274 if { $geom != "" } { 275 wm geometry $path $geom 276 } 277 278 if { [string equal $geometry ""] && ($geom == "") } { 279 set place [Widget::getoption $path -place] 280 if { ![string equal $place none] } { 281 if { [winfo exists $parent] } { 282 BWidget::place $path 0 0 $place $parent 283 } else { 284 BWidget::place $path 0 0 $place 285 } 286 } 287 } else { 288 if { $geom != "" } { 289 wm geometry $path $geom 290 } else { 291 wm geometry $path $geometry 292 } 293 } 294 update idletasks 295 wm overrideredirect $path $overrideredirect 296 wm deiconify $path 297 298 # patch by Bastien Chevreux (bach@mwgdna.com) 299 # As seen on Windows systems *sigh* 300 # When the toplevel is withdrawn, the tkwait command will wait forever. 301 # So, check that we are not withdrawn 302 if {![winfo exists $parent] || \ 303 ([wm state [winfo toplevel $parent]] != "withdrawn")} { 304 tkwait visibility $path 305 } 306 BWidget::focus set $path 307 if { [winfo exists $focus] } { 308 focus -force $focus 309 } else { 310 ButtonBox::setfocus $path.bbox default 311 } 312 313 if { [set grab [Widget::cget $path -modal]] != "none" } { 314 BWidget::grab $grab $path 315 if {[info exists _widget($path,result)]} { 316 unset _widget($path,result) 317 } 318 tkwait variable Dialog::_widget($path,result) 319 if { [info exists _widget($path,result)] } { 320 set res $_widget($path,result) 321 unset _widget($path,result) 322 } else { 323 set res -1 324 } 325 withdraw $path 326 return $res 327 } 328 return "" 329} 330 331 332# ---------------------------------------------------------------------------- 333# Command Dialog::withdraw 334# ---------------------------------------------------------------------------- 335proc Dialog::withdraw { path } { 336 BWidget::grab release $path 337 BWidget::focus release $path 338 if { [winfo exists $path] } { 339 wm withdraw $path 340 } 341} 342 343 344# ---------------------------------------------------------------------------- 345# Command Dialog::_destroy 346# ---------------------------------------------------------------------------- 347proc Dialog::_destroy { path } { 348 variable _widget 349 350 Dialog::enddialog $path -1 351 352 BWidget::grab release $path 353 BWidget::focus release $path 354 if {[info exists _widget($path,result)]} { 355 unset _widget($path,result) 356 } 357 unset _widget($path,realized) 358 unset _widget($path,nbut) 359 360 Widget::destroy $path 361} 362