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