1# ----------------------------------------------------------------------------
2#  dialog.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: dialog.tcl,v 1.11 2002/06/04 22:27:44 hobbs 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    ButtonBox::use
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    proc ::Dialog { path args } { return [eval Dialog::create $path $args] }
51    proc use {} {}
52
53    bind BwDialog <Destroy> {Dialog::enddialog %W -1; 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 -relief $re -borderwidth $bd -class $dialogClass
84
85    Widget::initFromODB Dialog $path $maps(Dialog)
86
87    bindtags $path [list $path BwDialog all]
88    wm overrideredirect $path 1
89    wm title $path [Widget::cget $path -title]
90    set parent [Widget::cget $path -parent]
91    if { ![winfo exists $parent] } {
92        set parent [winfo parent $path]
93    }
94   # JDC: made transient optional
95    if { [Widget::getoption $path -transient] } {
96	wm transient $path [winfo toplevel $parent]
97    }
98    wm withdraw $path
99
100    set side [Widget::cget $path -side]
101    if { ![string compare $side "left"] || ![string compare $side "right"] } {
102        set orient vertical
103    } else {
104        set orient horizontal
105    }
106
107    set bbox  [eval ButtonBox::create $path.bbox $maps(.bbox) -orient $orient]
108    set frame [frame $path.frame -relief flat -borderwidth 0]
109    set bg [Widget::cget $path -background]
110    $path configure -background $bg
111    $frame configure -background $bg
112    if { [set bitmap [Widget::getoption $path -image]] != "" } {
113        set label [label $path.label -image $bitmap -background $bg]
114    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
115        set label [label $path.label -bitmap $bitmap -background $bg]
116    }
117    if { [Widget::getoption $path -separator] } {
118                Separator::create $path.sep -orient $orient -background $bg
119    }
120    set _widget($path,realized) 0
121    set _widget($path,nbut)     0
122
123    bind $path <Escape>  "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]"
124    bind $path <Return>  "ButtonBox::invoke $path.bbox default"
125
126    rename $path ::$path:cmd
127    proc ::$path { cmd args } "return \[eval Dialog::\$cmd $path \$args\]"
128
129    return $path
130}
131
132
133# ----------------------------------------------------------------------------
134#  Command Dialog::configure
135# ----------------------------------------------------------------------------
136proc Dialog::configure { path args } {
137    set res [Widget::configure $path $args]
138
139    if { [Widget::hasChanged $path -title title] } {
140        wm title $path $title
141    }
142    if { [Widget::hasChanged $path -background bg] } {
143        if { [winfo exists $path.label] } {
144            $path.label configure -background $bg
145        }
146        if { [winfo exists $path.sep] } {
147            Separator::configure $path.sep -background $bg
148        }
149    }
150    return $res
151}
152
153
154# ----------------------------------------------------------------------------
155#  Command Dialog::cget
156# ----------------------------------------------------------------------------
157proc Dialog::cget { path option } {
158    return [Widget::cget $path $option]
159}
160
161
162# ----------------------------------------------------------------------------
163#  Command Dialog::getframe
164# ----------------------------------------------------------------------------
165proc Dialog::getframe { path } {
166    return $path.frame
167}
168
169
170# ----------------------------------------------------------------------------
171#  Command Dialog::add
172# ----------------------------------------------------------------------------
173proc Dialog::add { path args } {
174    variable _widget
175
176    set res [eval ButtonBox::add $path.bbox \
177                 -command [list "Dialog::enddialog $path $_widget($path,nbut)"] $args]
178    incr _widget($path,nbut)
179    return $res
180}
181
182
183# ----------------------------------------------------------------------------
184#  Command Dialog::itemconfigure
185# ----------------------------------------------------------------------------
186proc Dialog::itemconfigure { path index args } {
187    return [eval ButtonBox::itemconfigure $path.bbox $index $args]
188}
189
190
191# ----------------------------------------------------------------------------
192#  Command Dialog::itemcget
193# ----------------------------------------------------------------------------
194proc Dialog::itemcget { path index option } {
195    return [ButtonBox::itemcget $path.bbox $index $option]
196}
197
198
199# ----------------------------------------------------------------------------
200#  Command Dialog::invoke
201# ----------------------------------------------------------------------------
202proc Dialog::invoke { path index } {
203    ButtonBox::invoke $path.bbox $index
204}
205
206
207# ----------------------------------------------------------------------------
208#  Command Dialog::setfocus
209# ----------------------------------------------------------------------------
210proc Dialog::setfocus { path index } {
211    ButtonBox::setfocus $path.bbox $index
212}
213
214
215# ----------------------------------------------------------------------------
216#  Command Dialog::enddialog
217# ----------------------------------------------------------------------------
218proc Dialog::enddialog { path result } {
219    variable _widget
220
221    set _widget($path,result) $result
222}
223
224
225# ----------------------------------------------------------------------------
226#  Command Dialog::draw
227# ----------------------------------------------------------------------------
228proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} {
229    variable _widget
230
231    set parent [Widget::getoption $path -parent]
232    if { !$_widget($path,realized) } {
233        set _widget($path,realized) 1
234        if { [llength [winfo children $path.bbox]] } {
235            set side [Widget::getoption $path -side]
236            if { ![string compare $side "left"] || ![string compare $side "right"] } {
237                set pad  -padx
238                set fill y
239            } else {
240                set pad  -pady
241                set fill x
242            }
243            pack $path.bbox -side $side -anchor [Widget::getoption $path -anchor] -padx 1m -pady 1m
244            if { [winfo exists $path.sep] } {
245                pack $path.sep -side $side -fill $fill $pad 2m
246            }
247        }
248        if { [winfo exists $path.label] } {
249            pack $path.label -side left -anchor n -padx 3m -pady 3m
250        }
251        pack $path.frame -padx 1m -pady 1m -fill both -expand yes
252    }
253
254    set geom [Widget::getMegawidgetOption $path -geometry]
255    if { $geom != "" } {
256	wm geometry $path $geom
257    }
258
259    if { [string equal $geometry ""] && ($geom == "") } {
260	set place [Widget::getoption $path -place]
261	if { ![string equal $place none] } {
262	    if { [winfo exists $parent] } {
263		BWidget::place $path 0 0 $place $parent
264	    } else {
265		BWidget::place $path 0 0 $place
266	    }
267	}
268    } else {
269	if { $geom != "" } {
270	    wm geometry $path $geom
271	} else {
272	    wm geometry $path $geometry
273	}
274    }
275    update idletasks
276    wm overrideredirect $path $overrideredirect
277    wm deiconify $path
278
279    # patch by Bastien Chevreux (bach@mwgdna.com)
280    # As seen on Windows systems *sigh*
281    # When the toplevel is withdrawn, the tkwait command will wait forever.
282    #  So, check that we are not withdrawn
283    if {![winfo exists $parent] || \
284	    ([wm state [winfo toplevel $parent]] != "withdrawn")} {
285	tkwait visibility $path
286    }
287    BWidget::focus set $path
288    if { [winfo exists $focus] } {
289        focus -force $focus
290    } else {
291        ButtonBox::setfocus $path.bbox default
292    }
293
294    if { [set grab [Widget::cget $path -modal]] != "none" } {
295        BWidget::grab $grab $path
296        if {[info exists _widget($path,result)]} {
297            unset _widget($path,result)
298        }
299        tkwait variable Dialog::_widget($path,result)
300        if { [info exists _widget($path,result)] } {
301            set res $_widget($path,result)
302            unset _widget($path,result)
303        } else {
304            set res -1
305        }
306        withdraw $path
307        return $res
308    }
309    return ""
310}
311
312
313# ----------------------------------------------------------------------------
314#  Command Dialog::withdraw
315# ----------------------------------------------------------------------------
316proc Dialog::withdraw { path } {
317    BWidget::grab release $path
318    BWidget::focus release $path
319    if { [winfo exists $path] } {
320        wm withdraw $path
321    }
322}
323
324
325# ----------------------------------------------------------------------------
326#  Command Dialog::_destroy
327# ----------------------------------------------------------------------------
328proc Dialog::_destroy { path } {
329    variable _widget
330
331    BWidget::grab  release $path
332    BWidget::focus release $path
333    if {[info exists _widget($path,result)]} {
334        unset _widget($path,result)
335    }
336    unset _widget($path,realized)
337    unset _widget($path,nbut)
338
339    Widget::destroy $path
340    rename $path {}
341}
342