← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/amsn/gutsy

« back to all changes in this revision

Viewing changes to plugins/BWidget-1.7.0/dialog.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Theodore Karkoulis
  • Date: 2006-01-04 15:26:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060104152602-ipe1yg00rl3nlklv
Tags: 0.95-1
http://bugs.debian.org/345052
http://bugs.debian.org/278575
New Upstream Release (closes: #345052, #278575).

Show diffs side-by-side

added added

removed removed

Lines of Context:
plugins/BWidget-1.7.0/dialog.tcl
1
 
# ----------------------------------------------------------------------------
2
 
#  dialog.tcl
3
 
#  This file is part of Unifix BWidget Toolkit
4
 
#  $Id: dialog.tcl,v 1.2 2004/03/27 15:31:43 airadier 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
 
 
24
 
namespace 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       e        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
 
# ----------------------------------------------------------------------------
59
 
proc 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
 
# ----------------------------------------------------------------------------
130
 
proc 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
 
# ----------------------------------------------------------------------------
151
 
proc Dialog::cget { path option } {
152
 
    return [Widget::cget $path $option]
153
 
}
154
 
 
155
 
 
156
 
# ----------------------------------------------------------------------------
157
 
#  Command Dialog::getframe
158
 
# ----------------------------------------------------------------------------
159
 
proc Dialog::getframe { path } {
160
 
    return $path.frame
161
 
}
162
 
 
163
 
 
164
 
# ----------------------------------------------------------------------------
165
 
#  Command Dialog::add
166
 
# ----------------------------------------------------------------------------
167
 
proc 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
 
# ----------------------------------------------------------------------------
181
 
proc Dialog::itemconfigure { path index args } {
182
 
    return [eval [list ButtonBox::itemconfigure $path.bbox $index] $args]
183
 
}
184
 
 
185
 
 
186
 
# ----------------------------------------------------------------------------
187
 
#  Command Dialog::itemcget
188
 
# ----------------------------------------------------------------------------
189
 
proc Dialog::itemcget { path index option } {
190
 
    return [ButtonBox::itemcget $path.bbox $index $option]
191
 
}
192
 
 
193
 
 
194
 
# ----------------------------------------------------------------------------
195
 
#  Command Dialog::invoke
196
 
# ----------------------------------------------------------------------------
197
 
proc Dialog::invoke { path index } {
198
 
    ButtonBox::invoke $path.bbox $index
199
 
}
200
 
 
201
 
 
202
 
# ----------------------------------------------------------------------------
203
 
#  Command Dialog::setfocus
204
 
# ----------------------------------------------------------------------------
205
 
proc Dialog::setfocus { path index } {
206
 
    ButtonBox::setfocus $path.bbox $index
207
 
}
208
 
 
209
 
 
210
 
# ----------------------------------------------------------------------------
211
 
#  Command Dialog::enddialog
212
 
# ----------------------------------------------------------------------------
213
 
proc Dialog::enddialog { path result } {
214
 
    variable _widget
215
 
 
216
 
    set _widget($path,result) $result
217
 
}
218
 
 
219
 
 
220
 
# ----------------------------------------------------------------------------
221
 
#  Command Dialog::draw
222
 
# ----------------------------------------------------------------------------
223
 
proc 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
 
# ----------------------------------------------------------------------------
311
 
proc 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
 
# ----------------------------------------------------------------------------
323
 
proc 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
 
}