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