/[ascend]/trunk/tcltk/tk/templates/ascListSelectB1.tcl
ViewVC logotype

Contents of /trunk/tcltk/tk/templates/ascListSelectB1.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2022 - (show annotations) (download) (as text)
Wed Apr 29 06:20:28 2009 UTC (10 years, 9 months ago) by jpye
File MIME type: text/x-tcl
File size: 11107 byte(s)
Rename generic/interface to interface and TK to tk.
1 # Program: ascListSelectB1Box.tcl
2 # Tcl version: 7.1 (Tcl/Tk/XF)
3 # Tk version: 3.4
4 # XF version: 2.2
5 # Ben Allan may 22 1996 ballan@cs.cmu.edu
6 # $Revision: 1.10 $
7 # $Date: 1998/06/11 14:10:24 $
8 # This box is like the ascListSelectB1Box.tcl file
9 # except that instead of OK and Cancel buttons it has just 1
10 # Dismiss button.
11 #
12 # requires ascKeepOnTop.tcl if a grabby selection is used
13 #
14
15 global ascListSelectB1Box
16 set ascListSelectB1Box(button) 0
17 set ascListSelectB1Box(itemselected) ""
18 set ascListSelectB1Box(selectmode) browse
19 set ascListSelectB1Box(toplevelname) ".asclistselect"
20 set ascListSelectB1Box(grab) 0
21 set ascListSelectB1Box(btn2name) Help
22 set ascListSelectB1Box(btn2command) {puts "Help pushed"}
23 set ascListSelectB1Box(btn2destroy) 0
24 set ascListSelectB1Box(btn3name) ""
25 set ascListSelectB1Box(btn3command) ""
26 set ascListSelectB1Box(btn3destroy) 0
27 set ascListSelectB1Box(btn4name) ""
28 set ascListSelectB1Box(btn4command) ""
29 set ascListSelectB1Box(btn4destroy) 0
30 set ascListSelectB1Box(btn5name) ""
31 set ascListSelectB1Box(btn5command) ""
32 set ascListSelectB1Box(btn5destroy) 0
33 set ascListSelectB1Box(font) -*-*
34 set ascListSelectB1Box(title) ListSelect
35 set ascListSelectB1Box(headline) "Choices:"
36 #
37 # proc AscListSelectB1SelectAll {{toplevel ""}}
38 #---------------------------------------------------------------------------
39 # tags with sel tag everything in the list box for the toplevel
40 # given, which must be one of these AscListSelectB1Boxes.
41 # if toplevel not given, box in ascListSelectB1Box(toplevelname)
42 # will be tagged if it exists.
43 #---------------------------------------------------------------------------
44 proc AscListSelectB1SelectAll {{toplevel ""}} {
45 global ascListSelectB1Box
46 if {$toplevel == ""} {
47 set toplevel "$ascListSelectB1Box(toplevelname)"
48 }
49 $toplevel.main_frm.lb_frame.listbox1 select set 0 end
50 }
51 #
52 # proc AscListSelectB1Box {ascListSelectB1BoxInfo \
53 # {ascListSelectB1BoxGeom 250x240}}
54 #---------------------------------------------------------------------------
55 # pretty descriptive name, eh?
56 # Returns number of button pressed, also setting array button to that value.
57 # Item(s) selected will be in ascListSelectB1Box(itemselected).
58 # The values of
59 # ascListSelectB1Box(selectmode)
60 # ascListSelectB1Box(grab)
61 # ascListSelectB1Box(toplevelname)
62 # ascListSelectB1Box(title) (window manager title)
63 # ascListSelectB1Box(headline) (box heading)
64 # ascListSelectB1Box(btn2name)
65 # ascListSelectB1Box(btn2command) should be a procedure name.
66 # ascListSelectB1Box(btn2destroy)
67 # ascListSelectB1Box(btn3name)
68 # ascListSelectB1Box(btn3command) should be a procedure name.
69 # ascListSelectB1Box(btn3destroy)
70 # ascListSelectB1Box(btn4name)
71 # ascListSelectB1Box(btn4command) should be a procedure name.
72 # ascListSelectB1Box(btn4destroy)
73 # ascListSelectB1Box(btn5name)
74 # ascListSelectB1Box(btn5command) should be a procedure name.
75 # ascListSelectB1Box(btn5destroy)
76 # are consulted at build time.
77 # If another box with the same toplevel name
78 # exists, build is aborted and cancel button is returned.
79 # If grab is true, the box will have a grab on it.
80 # grab or no grab, this beast may commandeer the command line.
81 # If btn2/3/4/5name is "", no btn2/3/4/5 will be built
82 # If btn2/3/4/5destroy is 1,
83 # btn2/3/4/5 will do its command and destroy the window,else
84 # btn2/3/4/5 will just do its command. In either case, the selection will be
85 # in ascListSelectB1Box(itemselected) when btn2/3/4/5command is called.
86 # $btn2/3/4/5command should not require arguments.
87 # It is a good idea to set the ascListSelectB1Box array every time
88 # you call this, as others are likely using it also.
89 # Widget configurables:
90 # ascListSelectB1Box(font) -*-* (duh)
91 #---------------------------------------------------------------------------
92 proc AscListSelectB1Box {ascListSelectB1BoxInfo {ascListSelectB1BoxGeom 250x240}} {
93
94 global ascListSelectB1Box
95
96 # if no list or conflicting toplevel, return cancel
97 if {$ascListSelectB1BoxInfo == ""} {
98 set ascListSelectB1Box(button) 2
99 set ascListSelectB1Box(itemselected) ""
100 catch {
101 wm deiconify $ascListSelectB1Box(toplevel);
102 raise $ascListSelectB1Box
103 }
104 return 2
105 }
106 if {[winfo exists $ascListSelectB1Box(toplevelname)]} {
107 destroy $ascListSelectB1Box(toplevelname)
108 }
109 set tl $ascListSelectB1Box(toplevelname)
110 # build widget
111 toplevel $tl
112
113 # Window manager configurations
114 #global tk_version
115 wm positionfrom $tl user
116 wm sizefrom $tl user
117 wm minsize $tl 250 240
118 wm geometry $tl $ascListSelectB1BoxGeom
119 wm title $tl $ascListSelectB1Box(title)
120
121 # build widget $tl.buttons_frm
122 frame $tl.buttons_frm \
123 -borderwidth 0
124
125 # build widget $tl.buttons_frm.btn2
126 if {$ascListSelectB1Box(btn2name)!=""} {
127 button $tl.buttons_frm.btn2 \
128 -borderwidth 1 \
129 -font $ascListSelectB1Box(font) \
130 -text $ascListSelectB1Box(btn2name) \
131 -padx 0 \
132 -width [string length $ascListSelectB1Box(btn2name)] \
133 -command "
134 global ascListSelectB1Box
135 set ascListSelectB1Box(button) 2
136 ascLSB1OKCommand $tl
137 $ascListSelectB1Box(btn2command)"
138 if {$ascListSelectB1Box(btn2destroy)} {
139 $tl.buttons_frm.btn2 config -command "
140 global ascListSelectB1Box
141 set ascListSelectB1Box(button) 2
142 ascLSB1OKCommand $tl
143 $ascListSelectB1Box(btn2command)
144 destroy $tl"
145 }
146 }
147
148 # build widget $tl.buttons_frm.btn3
149 if {$ascListSelectB1Box(btn3name)!=""} {
150 button $tl.buttons_frm.btn3 \
151 -font $ascListSelectB1Box(font) \
152 -text $ascListSelectB1Box(btn3name) \
153 -width [string length $ascListSelectB1Box(btn3name)] \
154 -command "
155 global ascListSelectB1Box
156 set ascListSelectB1Box(button) 3
157 ascLSB1OKCommand $tl
158 $ascListSelectB1Box(btn3command)"
159 if {$ascListSelectB1Box(btn3destroy)} {
160 $tl.buttons_frm.btn3 config -command "
161 global ascListSelectB1Box
162 set ascListSelectB1Box(button) 3
163 ascLSB1OKCommand $tl
164 $ascListSelectB1Box(btn3command)
165 destroy $tl"
166 }
167 }
168
169 # build widget $tl.buttons_frm.btn4
170 if {$ascListSelectB1Box(btn4name)!=""} {
171 button $tl.buttons_frm.btn4 \
172 -font $ascListSelectB1Box(font) \
173 -text $ascListSelectB1Box(btn4name) \
174 -padx 0 \
175 -width [string length $ascListSelectB1Box(btn4name)] \
176 -command "
177 global ascListSelectB1Box
178 set ascListSelectB1Box(button) 4
179 ascLSB1OKCommand $tl
180 $ascListSelectB1Box(btn4command)"
181 if {$ascListSelectB1Box(btn4destroy)} {
182 $tl.buttons_frm.btn4 config -command "
183 global ascListSelectB1Box
184 set ascListSelectB1Box(button) 4
185 ascLSB1OKCommand $tl
186 $ascListSelectB1Box(btn4command)
187 destroy $tl"
188 }
189 }
190 # build widget $tl.buttons_frm.btn5
191 if {$ascListSelectB1Box(btn5name)!=""} {
192 button $tl.buttons_frm.btn5 \
193 -borderwidth 1 \
194 -font $ascListSelectB1Box(font) \
195 -text $ascListSelectB1Box(btn5name) \
196 -padx 0 \
197 -width [string length $ascListSelectB1Box(btn5name)] \
198 -command "
199 global ascListSelectB1Box
200 set ascListSelectB1Box(button) 5
201 ascLSB1OKCommand $tl
202 $ascListSelectB1Box(btn5command)"
203 if {$ascListSelectB1Box(btn5destroy)} {
204 $tl.buttons_frm.btn5 config -command "
205 global ascListSelectB1Box
206 set ascListSelectB1Box(button) 5
207 ascLSB1OKCommand $tl
208 $ascListSelectB1Box(btn5command)
209 destroy $tl"
210 }
211 }
212 # build widget $tl.buttons_frm.ok_button
213 button $tl.buttons_frm.ok_button \
214 -borderwidth 1 \
215 -text {Dismiss} \
216 -font $ascListSelectB1Box(font) \
217 -padx 0 \
218 -width 7 \
219 -command "
220 global ascListSelectB1Box
221 ascLSB1OKCommand $tl
222 set ascListSelectB1Box(button) 1
223 destroy $tl"
224
225 # these did have center expand fill before
226 # pack widget $tl.buttons_frm
227 pack append $tl.buttons_frm \
228 $tl.buttons_frm.ok_button {left frame center fill}
229 if {$ascListSelectB1Box(btn2name)!=""} {
230 pack append $tl.buttons_frm \
231 $tl.buttons_frm.btn2 {left frame center fill}
232 }
233 if {$ascListSelectB1Box(btn3name)!=""} {
234 pack append $tl.buttons_frm \
235 $tl.buttons_frm.btn3 {left frame center fill}
236 }
237 if {$ascListSelectB1Box(btn4name)!=""} {
238 pack append $tl.buttons_frm \
239 $tl.buttons_frm.btn4 {left frame center fill}
240 }
241 if {$ascListSelectB1Box(btn5name)!=""} {
242 pack append $tl.buttons_frm \
243 $tl.buttons_frm.btn5 {left frame center fill}
244 }
245
246 # build widget $tl.lbl_frm
247 frame $tl.lbl_frm
248
249 # build widget $tl.lbl_frm.main_label
250 label $tl.lbl_frm.main_label \
251 -borderwidth {0} \
252 -text $ascListSelectB1Box(headline)
253
254 # pack widget $tl.lbl_frm
255 if {$ascListSelectB1Box(grab)} {
256 canvas $tl.lbl_frm.bmcanvas -width 33 -height 27
257 $tl.lbl_frm.bmcanvas create bitmap 0 0 \
258 -background yellow \
259 -anchor nw \
260 -bitmap grablock
261 pack append $tl.lbl_frm $tl.lbl_frm.bmcanvas {left frame w}
262 }
263
264 pack append $tl.lbl_frm \
265 $tl.lbl_frm.main_label {top frame center pady 5 fillx}
266
267 # build widget $tl.main_frm
268 frame $tl.main_frm
269
270 # build widget $tl.main_frm.lb_frame
271 frame $tl.main_frm.lb_frame
272
273 # build widget $tl.main_frm.lb_frame.scrollbar2
274 scrollbar $tl.main_frm.lb_frame.scrollbar2 \
275 -command "$tl.main_frm.lb_frame.listbox1 yview"
276
277 # build widget $tl.main_frm.lb_frame.listbox1
278 listbox $tl.main_frm.lb_frame.listbox1 \
279 -exportselection 0 \
280 -font $ascListSelectB1Box(font) \
281 -selectmode $ascListSelectB1Box(selectmode) \
282 -width 30 \
283 -height 5 \
284 -yscrollcommand "$tl.main_frm.lb_frame.scrollbar2 set"
285
286 # pack widget $tl.main_frm.lb_frame
287 pack append $tl.main_frm.lb_frame \
288 $tl.main_frm.lb_frame.scrollbar2 {right frame center filly} \
289 $tl.main_frm.lb_frame.listbox1 {top frame center expand fill}
290
291 # pack widget $tl.main_frm
292 pack append $tl.main_frm \
293 $tl.main_frm.lb_frame {top frame center expand fill}
294
295 # pack widget $tl
296 pack append $tl \
297 $tl.lbl_frm {top frame center pady 5 fillx} \
298 $tl.main_frm {top frame center expand fill} \
299 $tl.buttons_frm {top frame center fill}
300
301 proc DestroyWindow$tl {} "
302 destroy $tl
303 update"
304
305 # Stuff the information given.
306 if {$ascListSelectB1BoxInfo != ""} {
307 foreach item $ascListSelectB1BoxInfo {
308 $tl.main_frm.lb_frame.listbox1 insert end $item
309 }
310 }
311
312 update idletask
313 if {$ascListSelectB1Box(grab)} {
314 bind $tl <Visibility> {ascKeepOnTop %W}
315 grab $tl
316 }
317 # wait for the box to be destroyed
318 tkwait window $tl
319 return $ascListSelectB1Box(button)
320 }
321
322 proc ascLSB1OKCommand {tl} {
323 global ascListSelectB1Box
324 set ascListSelectB1Box(itemselected) \
325 [ascGetListSelection $tl.main_frm.lb_frame.listbox1]
326 }
327 #ifndef
328 if {[info proc ascGetListSelection]!="ascGetListSelection"} {
329 #
330 # returns the selection from a listbox widget as a list.
331 proc ascGetListSelection {w} {
332 set indices [$w curselection]
333 set a ""
334 foreach i $indices {
335 lappend a [$w get $i]
336 }
337 return $a
338 }
339 }
340
341 # eof

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22