|
2
|
1 #!/usr/local/bin/wish -f
|
|
|
2 # Program: bou
|
|
|
3 # Tcl version: 7.3 (Tcl/Tk/XF)
|
|
|
4 # Tk version: 3.6
|
|
|
5 # XF version: 2.2
|
|
|
6 #
|
|
|
7
|
|
|
8 # module inclusion
|
|
|
9 global env
|
|
|
10 global xfLoadPath
|
|
|
11 global xfLoadInfo
|
|
|
12 set xfLoadInfo 0
|
|
|
13 if {[info exists env(XF_LOAD_PATH)]} {
|
|
|
14 if {[string first $env(XF_LOAD_PATH) /usr/local/lib/] == -1} {
|
|
|
15 set xfLoadPath $env(XF_LOAD_PATH):/usr/local/lib/
|
|
|
16 } {
|
|
|
17 set xfLoadPath /usr/local/lib/
|
|
|
18 }
|
|
|
19 } {
|
|
|
20 set xfLoadPath /usr/local/lib/
|
|
|
21 }
|
|
|
22
|
|
|
23 global argc
|
|
|
24 global argv
|
|
|
25 global tkVersion
|
|
|
26 set tmpArgv ""
|
|
|
27 for {set counter 0} {$counter < $argc} {incr counter 1} {
|
|
|
28 case [string tolower [lindex $argv $counter]] in {
|
|
|
29 {-xfloadpath} {
|
|
|
30 incr counter 1
|
|
|
31 set xfLoadPath "[lindex $argv $counter]:$xfLoadPath"
|
|
|
32 }
|
|
|
33 {-xfstartup} {
|
|
|
34 incr counter 1
|
|
|
35 source [lindex $argv $counter]
|
|
|
36 }
|
|
|
37 {-xfbindfile} {
|
|
|
38 incr counter 1
|
|
|
39 set env(XF_BIND_FILE) "[lindex $argv $counter]"
|
|
|
40 }
|
|
|
41 {-xfcolorfile} {
|
|
|
42 incr counter 1
|
|
|
43 set env(XF_COLOR_FILE) "[lindex $argv $counter]"
|
|
|
44 }
|
|
|
45 {-xfcursorfile} {
|
|
|
46 incr counter 1
|
|
|
47 set env(XF_CURSOR_FILE) "[lindex $argv $counter]"
|
|
|
48 }
|
|
|
49 {-xffontfile} {
|
|
|
50 incr counter 1
|
|
|
51 set env(XF_FONT_FILE) "[lindex $argv $counter]"
|
|
|
52 }
|
|
|
53 {-xfmodelmono} {
|
|
|
54 if {$tkVersion >= 3.0} {
|
|
|
55 tk colormodel . monochrome
|
|
|
56 }
|
|
|
57 }
|
|
|
58 {-xfmodelcolor} {
|
|
|
59 if {$tkVersion >= 3.0} {
|
|
|
60 tk colormodel . color
|
|
|
61 }
|
|
|
62 }
|
|
|
63 {-xfloading} {
|
|
|
64 set xfLoadInfo 1
|
|
|
65 }
|
|
|
66 {-xfnoloading} {
|
|
|
67 set xfLoadInfo 0
|
|
|
68 }
|
|
|
69 {default} {
|
|
|
70 lappend tmpArgv [lindex $argv $counter]
|
|
|
71 }
|
|
|
72 }
|
|
|
73 }
|
|
|
74 set argv $tmpArgv
|
|
|
75 set argc [llength $tmpArgv]
|
|
|
76 unset counter
|
|
|
77 unset tmpArgv
|
|
|
78
|
|
|
79
|
|
|
80 # procedure to show window .toy
|
|
|
81 proc ShowWindow.toy {args} {# xf ignore me 7
|
|
|
82
|
|
|
83 # build widget .toy
|
|
|
84 if {"[info procs XFEdit]" != ""} {
|
|
|
85 catch "XFDestroy .toy"
|
|
|
86 } {
|
|
|
87 catch "destroy .toy"
|
|
|
88 }
|
|
|
89 toplevel .toy \
|
|
|
90 -background {Cornsilk2} \
|
|
|
91 -relief {raised}
|
|
|
92
|
|
|
93 # Window manager configurations
|
|
|
94 global tkVersion
|
|
|
95 wm positionfrom .toy program
|
|
|
96 wm sizefrom .toy program
|
|
|
97 wm maxsize .toy 1000 1000
|
|
|
98 wm title .toy {Toy}
|
|
|
99
|
|
|
100
|
|
|
101 # build widget .toy.frame1
|
|
|
102 frame .toy.frame1 \
|
|
|
103 -background {Cornsilk2} \
|
|
|
104 -borderwidth {2} \
|
|
|
105 -height {293} \
|
|
|
106 -relief {raised} \
|
|
|
107 -width {141}
|
|
|
108
|
|
|
109 # build widget .toy.frame1.label2
|
|
|
110 label .toy.frame1.label2 \
|
|
|
111 -background {Cornsilk2} \
|
|
|
112 -font {8x16} \
|
|
|
113 -relief {raised} \
|
|
|
114 -text {Green}
|
|
|
115
|
|
|
116 # build widget .toy.frame1.label3
|
|
|
117 label .toy.frame1.label3 \
|
|
|
118 -background {Cornsilk2} \
|
|
|
119 -font {8x16} \
|
|
|
120 -relief {raised} \
|
|
|
121 -text {Red}
|
|
|
122
|
|
|
123 # build widget .toy.frame1.button4
|
|
|
124 button .toy.frame1.button4 \
|
|
|
125 -activebackground {#eed5b7} \
|
|
|
126 -background {Cornsilk2} \
|
|
|
127 -command {event quit} \
|
|
|
128 -disabledforeground {#b0b0b0} \
|
|
|
129 -font {8x16} \
|
|
|
130 -relief {flat} \
|
|
|
131 -text { Quit }
|
|
|
132
|
|
|
133 # build widget .toy.frame1.button5
|
|
|
134 button .toy.frame1.button5 \
|
|
|
135 -activebackground {#eed5b7} \
|
|
|
136 -background {Cornsilk2} \
|
|
|
137 -command {event stop} \
|
|
|
138 -disabledforeground {#b0b0b0} \
|
|
|
139 -font {8x16} \
|
|
|
140 -text {Stop}
|
|
|
141
|
|
|
142 # build widget .toy.frame1.button6
|
|
|
143 button .toy.frame1.button6 \
|
|
|
144 -activebackground {#eed5b7} \
|
|
|
145 -background {Cornsilk2} \
|
|
|
146 -command {event start} \
|
|
|
147 -disabledforeground {#b0b0b0} \
|
|
|
148 -font {8x16} \
|
|
|
149 -text {Run}
|
|
|
150
|
|
|
151 # pack widget .toy.frame1
|
|
|
152 pack append .toy.frame1 \
|
|
|
153 .toy.frame1.label2 {top frame center fillx} \
|
|
|
154 .toy.frame1.label3 {top frame center fillx} \
|
|
|
155 .toy.frame1.button4 {bottom frame center fillx} \
|
|
|
156 .toy.frame1.button5 {bottom frame center fillx} \
|
|
|
157 .toy.frame1.button6 {bottom frame center fillx}
|
|
|
158
|
|
|
159 # build widget .toy.canvas0
|
|
|
160 canvas .toy.canvas0 \
|
|
|
161 -background {Cornsilk2} \
|
|
|
162 -height {207} \
|
|
|
163 -insertofftime {600} \
|
|
|
164 -relief {raised} \
|
|
|
165 -selectbackground {#b2dfee} \
|
|
|
166 -selectborderwidth {1} \
|
|
|
167 -selectforeground {CornSilk2} \
|
|
|
168 -width {295}
|
|
|
169
|
|
|
170 # pack widget .toy
|
|
|
171 pack append .toy \
|
|
|
172 .toy.frame1 {right frame e filly} \
|
|
|
173 .toy.canvas0 {left frame center expand fill}
|
|
|
174
|
|
|
175 # build canvas items .toy.canvas0
|
|
|
176
|
|
|
177
|
|
|
178
|
|
|
179 if {"[info procs XFEdit]" != ""} {
|
|
|
180 catch "XFMiscBindWidgetTree .toy"
|
|
|
181 after 2 "catch {XFEditSetShowWindows}"
|
|
|
182 }
|
|
|
183 }
|
|
|
184
|
|
|
185 proc DestroyWindow.toy {} {# xf ignore me 7
|
|
|
186 if {"[info procs XFEdit]" != ""} {
|
|
|
187 if {"[info commands .toy]" != ""} {
|
|
|
188 global xfShowWindow.toy
|
|
|
189 set xfShowWindow.toy 0
|
|
|
190 XFEditSetPath .
|
|
|
191 after 2 "XFSaveAsProc .toy; XFEditSetShowWindows"
|
|
|
192 }
|
|
|
193 } {
|
|
|
194 catch "destroy .toy"
|
|
|
195 update
|
|
|
196 }
|
|
|
197 }
|
|
|
198
|
|
|
199
|
|
|
200 # procedure to show window .
|
|
|
201 proc ShowWindow. {args} {# xf ignore me 7
|
|
|
202
|
|
|
203 # Window manager configurations
|
|
|
204 global tkVersion
|
|
|
205 wm positionfrom . user
|
|
|
206 wm sizefrom . ""
|
|
|
207 wm maxsize . 1280 1024
|
|
|
208 wm title . {xf}
|
|
|
209
|
|
|
210
|
|
|
211 if {"[info procs XFEdit]" != ""} {
|
|
|
212 catch "XFMiscBindWidgetTree ."
|
|
|
213 after 2 "catch {XFEditSetShowWindows}"
|
|
|
214 }
|
|
|
215 }
|
|
|
216
|
|
|
217
|
|
|
218 # User defined procedures
|
|
|
219
|
|
|
220
|
|
|
221 # Procedure: event
|
|
|
222 proc event { args} {
|
|
|
223 prolog "tokio:tokio_event($args)"
|
|
|
224 # tokio
|
|
|
225 }
|
|
|
226
|
|
|
227
|
|
|
228 # Internal procedures
|
|
|
229
|
|
|
230
|
|
|
231 # Procedure: Alias
|
|
|
232 if {"[info procs Alias]" == ""} {
|
|
|
233 proc Alias { args} {
|
|
|
234 # xf ignore me 7
|
|
|
235 ##########
|
|
|
236 # Procedure: Alias
|
|
|
237 # Description: establish an alias for a procedure
|
|
|
238 # Arguments: args - no argument means that a list of all aliases
|
|
|
239 # is returned. Otherwise the first parameter is
|
|
|
240 # the alias name, and the second parameter is
|
|
|
241 # the procedure that is aliased.
|
|
|
242 # Returns: nothing, the command that is bound to the alias or a
|
|
|
243 # list of all aliases - command pairs.
|
|
|
244 # Sideeffects: internalAliasList is updated, and the alias
|
|
|
245 # proc is inserted
|
|
|
246 ##########
|
|
|
247 global internalAliasList
|
|
|
248
|
|
|
249 if {[llength $args] == 0} {
|
|
|
250 return $internalAliasList
|
|
|
251 } {
|
|
|
252 if {[llength $args] == 1} {
|
|
|
253 set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
|
|
|
254 if {$xfTmpIndex != -1} {
|
|
|
255 return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
|
|
|
256 }
|
|
|
257 } {
|
|
|
258 if {[llength $args] == 2} {
|
|
|
259 eval "proc [lindex $args 0] {args} {#xf ignore me 4
|
|
|
260 return \[eval \"[lindex $args 1] \$args\"\]}"
|
|
|
261 set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
|
|
|
262 if {$xfTmpIndex != -1} {
|
|
|
263 set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
|
|
|
264 } {
|
|
|
265 lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
|
|
|
266 }
|
|
|
267 } {
|
|
|
268 error "Alias: wrong number or args: $args"
|
|
|
269 }
|
|
|
270 }
|
|
|
271 }
|
|
|
272 }
|
|
|
273 }
|
|
|
274
|
|
|
275
|
|
|
276 # Procedure: GetSelection
|
|
|
277 if {"[info procs GetSelection]" == ""} {
|
|
|
278 proc GetSelection {} {
|
|
|
279 # xf ignore me 7
|
|
|
280 ##########
|
|
|
281 # Procedure: GetSelection
|
|
|
282 # Description: get current selection
|
|
|
283 # Arguments: none
|
|
|
284 # Returns: none
|
|
|
285 # Sideeffects: none
|
|
|
286 ##########
|
|
|
287
|
|
|
288 # the save way
|
|
|
289 set xfSelection ""
|
|
|
290 catch "selection get" xfSelection
|
|
|
291 if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
|
|
|
292 return ""
|
|
|
293 } {
|
|
|
294 return $xfSelection
|
|
|
295 }
|
|
|
296 }
|
|
|
297 }
|
|
|
298
|
|
|
299
|
|
|
300 # Procedure: MenuPopupAdd
|
|
|
301 if {"[info procs MenuPopupAdd]" == ""} {
|
|
|
302 proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} {
|
|
|
303 # xf ignore me 7
|
|
|
304 # the popup menu handling is from (I already gave up with popup handling :-):
|
|
|
305 #
|
|
|
306 # Copyright 1991,1992 by James Noble.
|
|
|
307 # Everyone is granted permission to copy, modify and redistribute.
|
|
|
308 # This notice must be preserved on all copies or derivates.
|
|
|
309 #
|
|
|
310 ##########
|
|
|
311 # Procedure: MenuPopupAdd
|
|
|
312 # Description: attach a popup menu to widget
|
|
|
313 # Arguments: xfW - the widget
|
|
|
314 # xfButton - the button we use
|
|
|
315 # xfMenu - the menu to attach
|
|
|
316 # {xfModifier} - a optional modifier
|
|
|
317 # {xfCanvasTag} - a canvas tagOrId
|
|
|
318 # Returns: none
|
|
|
319 # Sideeffects: none
|
|
|
320 ##########
|
|
|
321 global tk_popupPriv
|
|
|
322
|
|
|
323 set tk_popupPriv($xfMenu,focus) ""
|
|
|
324 set tk_popupPriv($xfMenu,grab) ""
|
|
|
325 if {"$xfModifier" != ""} {
|
|
|
326 set press "$xfModifier-"
|
|
|
327 set motion "$xfModifier-"
|
|
|
328 set release "Any-"
|
|
|
329 } {
|
|
|
330 set press ""
|
|
|
331 set motion ""
|
|
|
332 set release ""
|
|
|
333 }
|
|
|
334
|
|
|
335 bind $xfMenu "<${motion}B${xfButton}-Motion>" "MenuPopupMotion $xfMenu %W %X %Y"
|
|
|
336 bind $xfMenu "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
337 if {"$xfCanvasTag" == ""} {
|
|
|
338 bind $xfW "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y"
|
|
|
339 bind $xfW "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
340 } {
|
|
|
341 $xfW bind $xfCanvasTag "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y"
|
|
|
342 $xfW bind $xfCanvasTag "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
343 }
|
|
|
344 }
|
|
|
345 }
|
|
|
346
|
|
|
347
|
|
|
348 # Procedure: MenuPopupMotion
|
|
|
349 if {"[info procs MenuPopupMotion]" == ""} {
|
|
|
350 proc MenuPopupMotion { xfMenu xfW xfX xfY} {
|
|
|
351 # xf ignore me 7
|
|
|
352 ##########
|
|
|
353 # Procedure: MenuPopupMotion
|
|
|
354 # Description: handle the popup menu motion
|
|
|
355 # Arguments: xfMenu - the topmost menu
|
|
|
356 # xfW - the menu
|
|
|
357 # xfX - the root x coordinate
|
|
|
358 # xfY - the root x coordinate
|
|
|
359 # Returns: none
|
|
|
360 # Sideeffects: none
|
|
|
361 ##########
|
|
|
362 global tk_popupPriv
|
|
|
363
|
|
|
364 if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
|
|
|
365 "[winfo class $xfW]" == "Menu" &&
|
|
|
366 [info exists tk_popupPriv($xfMenu,focus)] &&
|
|
|
367 "$tk_popupPriv($xfMenu,focus)" != "" &&
|
|
|
368 [info exists tk_popupPriv($xfMenu,grab)] &&
|
|
|
369 "$tk_popupPriv($xfMenu,grab)" != ""} {
|
|
|
370 set xfPopMinX [winfo rootx $xfW]
|
|
|
371 set xfPopMaxX [expr $xfPopMinX+[winfo width $xfW]]
|
|
|
372 if {$xfX >= $xfPopMinX && $xfX <= $xfPopMaxX} {
|
|
|
373 $xfW activate @[expr $xfY-[winfo rooty $xfW]]
|
|
|
374 if {![catch "$xfW entryconfig @[expr $xfY-[winfo rooty $xfW]] -menu" result]} {
|
|
|
375 if {"[lindex $result 4]" != ""} {
|
|
|
376 foreach binding [bind $xfMenu] {
|
|
|
377 bind [lindex $result 4] $binding [bind $xfMenu $binding]
|
|
|
378 }
|
|
|
379 }
|
|
|
380 }
|
|
|
381 } {
|
|
|
382 $xfW activate none
|
|
|
383 }
|
|
|
384 }
|
|
|
385 }
|
|
|
386 }
|
|
|
387
|
|
|
388
|
|
|
389 # Procedure: MenuPopupPost
|
|
|
390 if {"[info procs MenuPopupPost]" == ""} {
|
|
|
391 proc MenuPopupPost { xfMenu xfX xfY} {
|
|
|
392 # xf ignore me 7
|
|
|
393 ##########
|
|
|
394 # Procedure: MenuPopupPost
|
|
|
395 # Description: post the popup menu
|
|
|
396 # Arguments: xfMenu - the menu
|
|
|
397 # xfX - the root x coordinate
|
|
|
398 # xfY - the root x coordinate
|
|
|
399 # Returns: none
|
|
|
400 # Sideeffects: none
|
|
|
401 ##########
|
|
|
402 global tk_popupPriv
|
|
|
403
|
|
|
404 if {"[info commands $xfMenu]" != ""} {
|
|
|
405 if {![info exists tk_popupPriv($xfMenu,focus)]} {
|
|
|
406 set tk_popupPriv($xfMenu,focus) [focus]
|
|
|
407 } {
|
|
|
408 if {"$tk_popupPriv($xfMenu,focus)" == ""} {
|
|
|
409 set tk_popupPriv($xfMenu,focus) [focus]
|
|
|
410 }
|
|
|
411 }
|
|
|
412 set tk_popupPriv($xfMenu,grab) $xfMenu
|
|
|
413
|
|
|
414 catch "$xfMenu activate none"
|
|
|
415 catch "$xfMenu post $xfX $xfY"
|
|
|
416 catch "focus $xfMenu"
|
|
|
417 catch "grab -global $xfMenu"
|
|
|
418 }
|
|
|
419 }
|
|
|
420 }
|
|
|
421
|
|
|
422
|
|
|
423 # Procedure: MenuPopupRelease
|
|
|
424 if {"[info procs MenuPopupRelease]" == ""} {
|
|
|
425 proc MenuPopupRelease { xfMenu xfW} {
|
|
|
426 # xf ignore me 7
|
|
|
427 ##########
|
|
|
428 # Procedure: MenuPopupRelease
|
|
|
429 # Description: remove the popup menu
|
|
|
430 # Arguments: xfMenu - the topmost menu widget
|
|
|
431 # xfW - the menu widget
|
|
|
432 # Returns: none
|
|
|
433 # Sideeffects: none
|
|
|
434 ##########
|
|
|
435 global tk_popupPriv
|
|
|
436 global tkVersion
|
|
|
437
|
|
|
438 if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
|
|
|
439 "[winfo class $xfW]" == "Menu" &&
|
|
|
440 [info exists tk_popupPriv($xfMenu,focus)] &&
|
|
|
441 "$tk_popupPriv($xfMenu,focus)" != "" &&
|
|
|
442 [info exists tk_popupPriv($xfMenu,grab)] &&
|
|
|
443 "$tk_popupPriv($xfMenu,grab)" != ""} {
|
|
|
444 if {$tkVersion >= 3.0} {
|
|
|
445 catch "grab release $tk_popupPriv($xfMenu,grab)"
|
|
|
446 } {
|
|
|
447 catch "grab none"
|
|
|
448 }
|
|
|
449 catch "focus $tk_popupPriv($xfMenu,focus)"
|
|
|
450 set tk_popupPriv($xfMenu,focus) ""
|
|
|
451 set tk_popupPriv($xfMenu,grab) ""
|
|
|
452 if {"[$xfW index active]" != "none"} {
|
|
|
453 $xfW invoke active; catch "$xfMenu unpost"
|
|
|
454 }
|
|
|
455 }
|
|
|
456 catch "$xfMenu unpost"
|
|
|
457 }
|
|
|
458 }
|
|
|
459
|
|
|
460
|
|
|
461 # Procedure: NoFunction
|
|
|
462 if {"[info procs NoFunction]" == ""} {
|
|
|
463 proc NoFunction { args} {
|
|
|
464 # xf ignore me 7
|
|
|
465 ##########
|
|
|
466 # Procedure: NoFunction
|
|
|
467 # Description: do nothing (especially with scales and scrollbars)
|
|
|
468 # Arguments: args - a number of ignored parameters
|
|
|
469 # Returns: none
|
|
|
470 # Sideeffects: none
|
|
|
471 ##########
|
|
|
472 }
|
|
|
473 }
|
|
|
474
|
|
|
475
|
|
|
476 # Procedure: SN
|
|
|
477 if {"[info procs SN]" == ""} {
|
|
|
478 proc SN { {xfName ""}} {
|
|
|
479 # xf ignore me 7
|
|
|
480 ##########
|
|
|
481 # Procedure: SN
|
|
|
482 # Description: map a symbolic name to the widget path
|
|
|
483 # Arguments: xfName
|
|
|
484 # Returns: the symbolic name
|
|
|
485 # Sideeffects: none
|
|
|
486 ##########
|
|
|
487
|
|
|
488 SymbolicName $xfName
|
|
|
489 }
|
|
|
490 }
|
|
|
491
|
|
|
492
|
|
|
493 # Procedure: SymbolicName
|
|
|
494 if {"[info procs SymbolicName]" == ""} {
|
|
|
495 proc SymbolicName { {xfName ""}} {
|
|
|
496 # xf ignore me 7
|
|
|
497 ##########
|
|
|
498 # Procedure: SymbolicName
|
|
|
499 # Description: map a symbolic name to the widget path
|
|
|
500 # Arguments: xfName
|
|
|
501 # Returns: the symbolic name
|
|
|
502 # Sideeffects: none
|
|
|
503 ##########
|
|
|
504
|
|
|
505 global symbolicName
|
|
|
506
|
|
|
507 if {"$xfName" != ""} {
|
|
|
508 set xfArrayName ""
|
|
|
509 append xfArrayName symbolicName ( $xfName )
|
|
|
510 if {![catch "set \"$xfArrayName\"" xfValue]} {
|
|
|
511 return $xfValue
|
|
|
512 } {
|
|
|
513 if {"[info commands XFProcError]" != ""} {
|
|
|
514 XFProcError "Unknown symbolic name:\n$xfName"
|
|
|
515 } {
|
|
|
516 puts stderr "XF error: unknown symbolic name:\n$xfName"
|
|
|
517 }
|
|
|
518 }
|
|
|
519 }
|
|
|
520 return ""
|
|
|
521 }
|
|
|
522 }
|
|
|
523
|
|
|
524
|
|
|
525 # Procedure: Unalias
|
|
|
526 if {"[info procs Unalias]" == ""} {
|
|
|
527 proc Unalias { aliasName} {
|
|
|
528 # xf ignore me 7
|
|
|
529 ##########
|
|
|
530 # Procedure: Unalias
|
|
|
531 # Description: remove an alias for a procedure
|
|
|
532 # Arguments: aliasName - the alias name to remove
|
|
|
533 # Returns: none
|
|
|
534 # Sideeffects: internalAliasList is updated, and the alias
|
|
|
535 # proc is removed
|
|
|
536 ##########
|
|
|
537 global internalAliasList
|
|
|
538
|
|
|
539 set xfIndex [lsearch $internalAliasList "$aliasName *"]
|
|
|
540 if {$xfIndex != -1} {
|
|
|
541 rename $aliasName ""
|
|
|
542 set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
|
|
|
543 }
|
|
|
544 }
|
|
|
545 }
|
|
|
546
|
|
|
547
|
|
|
548
|
|
|
549 # application parsing procedure
|
|
|
550 proc XFLocalParseAppDefs {xfAppDefFile} {
|
|
|
551 global xfAppDefaults
|
|
|
552
|
|
|
553 # basically from: Michael Moore
|
|
|
554 if {[file exists $xfAppDefFile] &&
|
|
|
555 [file readable $xfAppDefFile] &&
|
|
|
556 "[file type $xfAppDefFile]" == "link"} {
|
|
|
557 catch "file type $xfAppDefFile" xfType
|
|
|
558 while {"$xfType" == "link"} {
|
|
|
559 if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} {
|
|
|
560 return
|
|
|
561 }
|
|
|
562 catch "file type $xfAppDefFile" xfType
|
|
|
563 }
|
|
|
564 }
|
|
|
565 if {!("$xfAppDefFile" != "" &&
|
|
|
566 [file exists $xfAppDefFile] &&
|
|
|
567 [file readable $xfAppDefFile] &&
|
|
|
568 "[file type $xfAppDefFile]" == "file")} {
|
|
|
569 return
|
|
|
570 }
|
|
|
571 if {![catch "open $xfAppDefFile r" xfResult]} {
|
|
|
572 set xfAppFileContents [read $xfResult]
|
|
|
573 close $xfResult
|
|
|
574 foreach line [split $xfAppFileContents "\n"] {
|
|
|
575 # backup indicates how far to backup. It applies to the
|
|
|
576 # situation where a resource name ends in . and when it
|
|
|
577 # ends in *. In the second case you want to keep the *
|
|
|
578 # in the widget name for pattern matching, but you want
|
|
|
579 # to get rid of the . if it is the end of the name.
|
|
|
580 set backup -2
|
|
|
581 set line [string trim $line]
|
|
|
582 if {[string index $line 0] == "#" || "$line" == ""} {
|
|
|
583 # skip comments and empty lines
|
|
|
584 continue
|
|
|
585 }
|
|
|
586 set list [split $line ":"]
|
|
|
587 set resource [string trim [lindex $list 0]]
|
|
|
588 set i [string last "." $resource]
|
|
|
589 set j [string last "*" $resource]
|
|
|
590 if {$j > $i} {
|
|
|
591 set i $j
|
|
|
592 set backup -1
|
|
|
593 }
|
|
|
594 incr i
|
|
|
595 set name [string range $resource $i end]
|
|
|
596 incr i $backup
|
|
|
597 set widname [string range $resource 0 $i]
|
|
|
598 set value [string trim [lindex $list 1]]
|
|
|
599 if {"$widname" != "" && "$widname" != "*"} {
|
|
|
600 # insert the widget and resourcename to the application
|
|
|
601 # defaults list.
|
|
|
602 if {![info exists xfAppDefaults]} {
|
|
|
603 set xfAppDefaults ""
|
|
|
604 }
|
|
|
605 lappend xfAppDefaults [list $widname [string tolower $name] $value]
|
|
|
606 }
|
|
|
607 }
|
|
|
608 }
|
|
|
609 }
|
|
|
610
|
|
|
611 # application loading procedure
|
|
|
612 proc XFLocalLoadAppDefs {{xfClasses ""} {xfPriority "startupFile"} {xfAppDefFile ""}} {
|
|
|
613 global env
|
|
|
614
|
|
|
615 if {"$xfAppDefFile" == ""} {
|
|
|
616 set xfFileList ""
|
|
|
617 if {[info exists env(XUSERFILESEARCHPATH)]} {
|
|
|
618 append xfFileList [split $env(XUSERFILESEARCHPATH) :]
|
|
|
619 }
|
|
|
620 if {[info exists env(XAPPLRESDIR)]} {
|
|
|
621 append xfFileList [split $env(XAPPLRESDIR) :]
|
|
|
622 }
|
|
|
623 if {[info exists env(XFILESEARCHPATH)]} {
|
|
|
624 append xfFileList [split $env(XFILESEARCHPATH) :]
|
|
|
625 }
|
|
|
626 append xfFileList " /usr/lib/X11/app-defaults"
|
|
|
627 append xfFileList " /usr/X11/lib/X11/app-defaults"
|
|
|
628
|
|
|
629 foreach xfCounter1 $xfClasses {
|
|
|
630 foreach xfCounter2 $xfFileList {
|
|
|
631 set xfPathName $xfCounter2
|
|
|
632 if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} {
|
|
|
633 set xfPathName $xfResult
|
|
|
634 }
|
|
|
635 if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} {
|
|
|
636 set xfPathName $xfResult
|
|
|
637 }
|
|
|
638 if {[regsub -all "%S" "$xfPathName" "" xfResult]} {
|
|
|
639 set xfPathName $xfResult
|
|
|
640 }
|
|
|
641 if {[regsub -all "%C" "$xfPathName" "" xfResult]} {
|
|
|
642 set xfPathName $xfResult
|
|
|
643 }
|
|
|
644 if {[file exists $xfPathName] &&
|
|
|
645 [file readable $xfPathName] &&
|
|
|
646 ("[file type $xfPathName]" == "file" ||
|
|
|
647 "[file type $xfPathName]" == "link")} {
|
|
|
648 catch "option readfile $xfPathName $xfPriority"
|
|
|
649 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
650 XFParseAppDefs $xfPathName
|
|
|
651 } {
|
|
|
652 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
653 XFLocalParseAppDefs $xfPathName
|
|
|
654 }
|
|
|
655 }
|
|
|
656 } {
|
|
|
657 if {[file exists $xfCounter2/$xfCounter1] &&
|
|
|
658 [file readable $xfCounter2/$xfCounter1] &&
|
|
|
659 ("[file type $xfCounter2/$xfCounter1]" == "file" ||
|
|
|
660 "[file type $xfCounter2/$xfCounter1]" == "link")} {
|
|
|
661 catch "option readfile $xfCounter2/$xfCounter1 $xfPriority"
|
|
|
662 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
663 XFParseAppDefs $xfCounter2/$xfCounter1
|
|
|
664 } {
|
|
|
665 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
666 XFLocalParseAppDefs $xfCounter2/$xfCounter1
|
|
|
667 }
|
|
|
668 }
|
|
|
669 }
|
|
|
670 }
|
|
|
671 }
|
|
|
672 }
|
|
|
673 } {
|
|
|
674 # load a specific application defaults file
|
|
|
675 if {[file exists $xfAppDefFile] &&
|
|
|
676 [file readable $xfAppDefFile] &&
|
|
|
677 ("[file type $xfAppDefFile]" == "file" ||
|
|
|
678 "[file type $xfAppDefFile]" == "link")} {
|
|
|
679 catch "option readfile $xfAppDefFile $xfPriority"
|
|
|
680 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
681 XFParseAppDefs $xfAppDefFile
|
|
|
682 } {
|
|
|
683 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
684 XFLocalParseAppDefs $xfAppDefFile
|
|
|
685 }
|
|
|
686 }
|
|
|
687 }
|
|
|
688 }
|
|
|
689 }
|
|
|
690
|
|
|
691 # application setting procedure
|
|
|
692 proc XFLocalSetAppDefs {{xfWidgetPath "."}} {
|
|
|
693 global xfAppDefaults
|
|
|
694
|
|
|
695 if {![info exists xfAppDefaults]} {
|
|
|
696 return
|
|
|
697 }
|
|
|
698 foreach xfCounter $xfAppDefaults {
|
|
|
699 if {"$xfCounter" == ""} {
|
|
|
700 break
|
|
|
701 }
|
|
|
702 set widname [lindex $xfCounter 0]
|
|
|
703 if {[string match $widname ${xfWidgetPath}] ||
|
|
|
704 [string match "${xfWidgetPath}*" $widname]} {
|
|
|
705 set name [string tolower [lindex $xfCounter 1]]
|
|
|
706 set value [lindex $xfCounter 2]
|
|
|
707 # Now lets see how many tcl commands match the name
|
|
|
708 # pattern specified.
|
|
|
709 set widlist [info command $widname]
|
|
|
710 if {"$widlist" != ""} {
|
|
|
711 foreach widget $widlist {
|
|
|
712 # make sure this command is a widget.
|
|
|
713 if {![catch "winfo id $widget"] &&
|
|
|
714 [string match "${xfWidgetPath}*" $widget]} {
|
|
|
715 catch "$widget configure -$name $value"
|
|
|
716 }
|
|
|
717 }
|
|
|
718 }
|
|
|
719 }
|
|
|
720 }
|
|
|
721 }
|
|
|
722
|
|
|
723
|
|
|
724 # prepare auto loading
|
|
|
725 global auto_path
|
|
|
726 global tk_library
|
|
|
727 global xfLoadPath
|
|
|
728 foreach xfElement [eval list [split $xfLoadPath :] $auto_path] {
|
|
|
729 if {[file exists $xfElement/tclIndex]} {
|
|
|
730 lappend auto_path $xfElement
|
|
|
731 }
|
|
|
732 }
|
|
|
733 catch "unset auto_index"
|
|
|
734
|
|
|
735 catch "unset auto_oldpath"
|
|
|
736
|
|
|
737 catch "unset auto_execs"
|
|
|
738
|
|
|
739
|
|
|
740 # initialize global variables
|
|
|
741 proc InitGlobals {} {
|
|
|
742 global {now}
|
|
|
743 set {now} {}
|
|
|
744
|
|
|
745 # please don't modify the following
|
|
|
746 # variables. They are needed by xf.
|
|
|
747 global {autoLoadList}
|
|
|
748 set {autoLoadList(bou.tcl)} {0}
|
|
|
749 set {autoLoadList(main.tcl)} {0}
|
|
|
750 global {internalAliasList}
|
|
|
751 set {internalAliasList} {}
|
|
|
752 global {moduleList}
|
|
|
753 set {moduleList(bou.tcl)} {}
|
|
|
754 global {preloadList}
|
|
|
755 set {preloadList(xfInternal)} {}
|
|
|
756 global {symbolicName}
|
|
|
757 set {symbolicName(c)} {.canvas0}
|
|
|
758 set {symbolicName(green)} {.frame1.label2}
|
|
|
759 set {symbolicName(quit)} {.frame1.button4}
|
|
|
760 set {symbolicName(red)} {.frame1.label3}
|
|
|
761 set {symbolicName(root)} {.}
|
|
|
762 set {symbolicName(run)} {.frame1.button6}
|
|
|
763 set {symbolicName(stop)} {.frame1.button5}
|
|
|
764 global {xfWmSetPosition}
|
|
|
765 set {xfWmSetPosition} {}
|
|
|
766 global {xfWmSetSize}
|
|
|
767 set {xfWmSetSize} {}
|
|
|
768 global {xfAppDefToplevels}
|
|
|
769 set {xfAppDefToplevels} {}
|
|
|
770 }
|
|
|
771
|
|
|
772 # initialize global variables
|
|
|
773 InitGlobals
|
|
|
774
|
|
|
775 # display/remove toplevel windows.
|
|
|
776 ShowWindow.
|
|
|
777
|
|
|
778 global xfShowWindow.toy
|
|
|
779 set xfShowWindow.toy 1
|
|
|
780 ShowWindow.toy
|
|
|
781
|
|
|
782 # load default bindings.
|
|
|
783 if {[info exists env(XF_BIND_FILE)] &&
|
|
|
784 "[info procs XFShowHelp]" == ""} {
|
|
|
785 source $env(XF_BIND_FILE)
|
|
|
786 }
|
|
|
787
|
|
|
788 # parse and apply application defaults.
|
|
|
789 XFLocalLoadAppDefs Bou
|
|
|
790 XFLocalSetAppDefs
|
|
|
791
|
|
|
792 # eof
|
|
|
793 #
|
|
|
794
|
