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