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