# ---------------------------------------------------------------------------- # dialog.tcl # This file is part of Unifix BWidget Toolkit # $Id: dialog.tcl,v 1.11 2002/06/04 22:27:44 hobbs Exp $ # ---------------------------------------------------------------------------- # Index of commands: # - Dialog::create # - Dialog::configure # - Dialog::cget # - Dialog::getframe # - Dialog::add # - Dialog::itemconfigure # - Dialog::itemcget # - Dialog::invoke # - Dialog::setfocus # - Dialog::enddialog # - Dialog::draw # - Dialog::withdraw # - Dialog::_destroy # ---------------------------------------------------------------------------- # JDC: added -transient and -place flag namespace eval Dialog { ButtonBox::use Widget::bwinclude Dialog ButtonBox .bbox \ remove {-orient} \ initialize {-spacing 10 -padx 10} Widget::declare Dialog { {-title String "" 0} {-geometry String "" 0} {-modal Enum local 0 {none local global}} {-bitmap TkResource "" 1 label} {-image TkResource "" 1 label} {-separator Boolean 0 1} {-cancel Int -1 0 "%d >= -1"} {-parent String "" 0} {-side Enum bottom 1 {bottom left top right}} {-anchor Enum c 1 {n e w s c}} {-class String Dialog 1} {-transient Boolean 1 1} {-place Enum center 0 {none center left right above below}} } Widget::addmap Dialog "" :cmd {-background {}} Widget::addmap Dialog "" .frame {-background {}} proc ::Dialog { path args } { return [eval Dialog::create $path $args] } proc use {} {} bind BwDialog {Dialog::enddialog %W -1; Dialog::_destroy %W} variable _widget } # ---------------------------------------------------------------------------- # Command Dialog::create # ---------------------------------------------------------------------------- proc Dialog::create { path args } { global tcl_platform variable _widget array set maps [list Dialog {} .bbox {}] array set maps [Widget::parseArgs Dialog $args] # Check to see if the -class flag was specified set dialogClass "Dialog" array set dialogArgs $maps(Dialog) if { [info exists dialogArgs(-class)] } { set dialogClass $dialogArgs(-class) } if { [string equal $tcl_platform(platform) "unix"] } { set re raised set bd 1 } else { set re flat set bd 0 } toplevel $path -relief $re -borderwidth $bd -class $dialogClass Widget::initFromODB Dialog $path $maps(Dialog) bindtags $path [list $path BwDialog all] wm overrideredirect $path 1 wm title $path [Widget::cget $path -title] set parent [Widget::cget $path -parent] if { ![winfo exists $parent] } { set parent [winfo parent $path] } # JDC: made transient optional if { [Widget::getoption $path -transient] } { wm transient $path [winfo toplevel $parent] } wm withdraw $path set side [Widget::cget $path -side] if { ![string compare $side "left"] || ![string compare $side "right"] } { set orient vertical } else { set orient horizontal } set bbox [eval ButtonBox::create $path.bbox $maps(.bbox) -orient $orient] set frame [frame $path.frame -relief flat -borderwidth 0] set bg [Widget::cget $path -background] $path configure -background $bg $frame configure -background $bg if { [set bitmap [Widget::getoption $path -image]] != "" } { set label [label $path.label -image $bitmap -background $bg] } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } { set label [label $path.label -bitmap $bitmap -background $bg] } if { [Widget::getoption $path -separator] } { Separator::create $path.sep -orient $orient -background $bg } set _widget($path,realized) 0 set _widget($path,nbut) 0 bind $path "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]" bind $path "ButtonBox::invoke $path.bbox default" rename $path ::$path:cmd proc ::$path { cmd args } "return \[eval Dialog::\$cmd $path \$args\]" return $path } # ---------------------------------------------------------------------------- # Command Dialog::configure # ---------------------------------------------------------------------------- proc Dialog::configure { path args } { set res [Widget::configure $path $args] if { [Widget::hasChanged $path -title title] } { wm title $path $title } if { [Widget::hasChanged $path -background bg] } { if { [winfo exists $path.label] } { $path.label configure -background $bg } if { [winfo exists $path.sep] } { Separator::configure $path.sep -background $bg } } return $res } # ---------------------------------------------------------------------------- # Command Dialog::cget # ---------------------------------------------------------------------------- proc Dialog::cget { path option } { return [Widget::cget $path $option] } # ---------------------------------------------------------------------------- # Command Dialog::getframe # ---------------------------------------------------------------------------- proc Dialog::getframe { path } { return $path.frame } # ---------------------------------------------------------------------------- # Command Dialog::add # ---------------------------------------------------------------------------- proc Dialog::add { path args } { variable _widget set res [eval ButtonBox::add $path.bbox \ -command [list "Dialog::enddialog $path $_widget($path,nbut)"] $args] incr _widget($path,nbut) return $res } # ---------------------------------------------------------------------------- # Command Dialog::itemconfigure # ---------------------------------------------------------------------------- proc Dialog::itemconfigure { path index args } { return [eval ButtonBox::itemconfigure $path.bbox $index $args] } # ---------------------------------------------------------------------------- # Command Dialog::itemcget # ---------------------------------------------------------------------------- proc Dialog::itemcget { path index option } { return [ButtonBox::itemcget $path.bbox $index $option] } # ---------------------------------------------------------------------------- # Command Dialog::invoke # ---------------------------------------------------------------------------- proc Dialog::invoke { path index } { ButtonBox::invoke $path.bbox $index } # ---------------------------------------------------------------------------- # Command Dialog::setfocus # ---------------------------------------------------------------------------- proc Dialog::setfocus { path index } { ButtonBox::setfocus $path.bbox $index } # ---------------------------------------------------------------------------- # Command Dialog::enddialog # ---------------------------------------------------------------------------- proc Dialog::enddialog { path result } { variable _widget set _widget($path,result) $result } # ---------------------------------------------------------------------------- # Command Dialog::draw # ---------------------------------------------------------------------------- proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} { variable _widget set parent [Widget::getoption $path -parent] if { !$_widget($path,realized) } { set _widget($path,realized) 1 if { [llength [winfo children $path.bbox]] } { set side [Widget::getoption $path -side] if { ![string compare $side "left"] || ![string compare $side "right"] } { set pad -padx set fill y } else { set pad -pady set fill x } pack $path.bbox -side $side -anchor [Widget::getoption $path -anchor] -padx 1m -pady 1m if { [winfo exists $path.sep] } { pack $path.sep -side $side -fill $fill $pad 2m } } if { [winfo exists $path.label] } { pack $path.label -side left -anchor n -padx 3m -pady 3m } pack $path.frame -padx 1m -pady 1m -fill both -expand yes } set geom [Widget::getMegawidgetOption $path -geometry] if { $geom != "" } { wm geometry $path $geom } if { [string equal $geometry ""] && ($geom == "") } { set place [Widget::getoption $path -place] if { ![string equal $place none] } { if { [winfo exists $parent] } { BWidget::place $path 0 0 $place $parent } else { BWidget::place $path 0 0 $place } } } else { if { $geom != "" } { wm geometry $path $geom } else { wm geometry $path $geometry } } update idletasks wm overrideredirect $path $overrideredirect wm deiconify $path # patch by Bastien Chevreux (bach@mwgdna.com) # As seen on Windows systems *sigh* # When the toplevel is withdrawn, the tkwait command will wait forever. # So, check that we are not withdrawn if {![winfo exists $parent] || \ ([wm state [winfo toplevel $parent]] != "withdrawn")} { tkwait visibility $path } BWidget::focus set $path if { [winfo exists $focus] } { focus -force $focus } else { ButtonBox::setfocus $path.bbox default } if { [set grab [Widget::cget $path -modal]] != "none" } { BWidget::grab $grab $path if {[info exists _widget($path,result)]} { unset _widget($path,result) } tkwait variable Dialog::_widget($path,result) if { [info exists _widget($path,result)] } { set res $_widget($path,result) unset _widget($path,result) } else { set res -1 } withdraw $path return $res } return "" } # ---------------------------------------------------------------------------- # Command Dialog::withdraw # ---------------------------------------------------------------------------- proc Dialog::withdraw { path } { BWidget::grab release $path BWidget::focus release $path if { [winfo exists $path] } { wm withdraw $path } } # ---------------------------------------------------------------------------- # Command Dialog::_destroy # ---------------------------------------------------------------------------- proc Dialog::_destroy { path } { variable _widget BWidget::grab release $path BWidget::focus release $path if {[info exists _widget($path,result)]} { unset _widget($path,result) } unset _widget($path,realized) unset _widget($path,nbut) Widget::destroy $path rename $path {} }