|
2
|
1 #!/usr/local/bin/wish -f
|
|
|
2 # Program: xf-disp
|
|
|
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 .top0
|
|
|
81 proc ShowWindow.top0 {args} {# xf ignore me 7
|
|
|
82
|
|
|
83 # build widget .top0
|
|
|
84 if {"[info procs XFEdit]" != ""} {
|
|
|
85 catch "XFDestroy .top0"
|
|
|
86 } {
|
|
|
87 catch "destroy .top0"
|
|
|
88 }
|
|
|
89 toplevel .top0 \
|
|
|
90 -background {Cornsilk2}
|
|
|
91
|
|
|
92 # Window manager configurations
|
|
|
93 global tkVersion
|
|
|
94 wm positionfrom .top0 ""
|
|
|
95 wm sizefrom .top0 ""
|
|
|
96 wm maxsize .top0 1000 1000
|
|
|
97 wm minsize .top0 10 10
|
|
|
98 wm title .top0 {Execution}
|
|
|
99
|
|
|
100
|
|
|
101 # build widget .top0.frame0
|
|
|
102 frame .top0.frame0 \
|
|
|
103 -background {Cornsilk2} \
|
|
|
104 -relief {raised}
|
|
|
105
|
|
|
106 # build widget .top0.frame0.scrollbar3
|
|
|
107 scrollbar .top0.frame0.scrollbar3 \
|
|
|
108 -activeforeground {CornSilk2} \
|
|
|
109 -background {Cornsilk2} \
|
|
|
110 -command {.top0.frame0.canvas2 xview} \
|
|
|
111 -foreground {#ffe4c4} \
|
|
|
112 -orient {horizontal} \
|
|
|
113 -relief {raised}
|
|
|
114
|
|
|
115 # build widget .top0.frame0.scrollbar1
|
|
|
116 scrollbar .top0.frame0.scrollbar1 \
|
|
|
117 -activeforeground {CornSilk2} \
|
|
|
118 -background {Cornsilk2} \
|
|
|
119 -command {.top0.frame0.canvas2 yview} \
|
|
|
120 -foreground {#ffe4c4} \
|
|
|
121 -relief {raised}
|
|
|
122
|
|
|
123 # build widget .top0.frame0.canvas2
|
|
|
124 canvas .top0.frame0.canvas2 \
|
|
|
125 -background {Cornsilk2} \
|
|
|
126 -confine {0} \
|
|
|
127 -height {384} \
|
|
|
128 -insertofftime {600} \
|
|
|
129 -relief {raised} \
|
|
|
130 -scrollregion {-1c -1c 20c 20c} \
|
|
|
131 -selectbackground {#b2dfee} \
|
|
|
132 -selectborderwidth {1} \
|
|
|
133 -selectforeground {CornSilk2} \
|
|
|
134 -width {394} \
|
|
|
135 -xscrollcommand {.top0.frame0.scrollbar3 set} \
|
|
|
136 -yscrollcommand {.top0.frame0.scrollbar1 set}
|
|
|
137 # bindings
|
|
|
138 bind .top0.frame0.canvas2 <Button-1> {crosshair .top0.frame0.canvas2 %x %y}
|
|
|
139
|
|
|
140 # pack widget .top0.frame0
|
|
|
141 pack append .top0.frame0 \
|
|
|
142 .top0.frame0.scrollbar1 {right frame center filly} \
|
|
|
143 .top0.frame0.canvas2 {top frame center expand fill} \
|
|
|
144 .top0.frame0.scrollbar3 {top frame center fillx}
|
|
|
145
|
|
|
146 # build widget .top0.frame1
|
|
|
147 frame .top0.frame1 \
|
|
|
148 -background {Cornsilk2} \
|
|
|
149 -borderwidth {2} \
|
|
|
150 -relief {raised}
|
|
|
151
|
|
|
152 # build widget .top0.frame1.label6
|
|
|
153 label .top0.frame1.label6 \
|
|
|
154 -anchor {w} \
|
|
|
155 -background {Cornsilk2} \
|
|
|
156 -font {8x16} \
|
|
|
157 -kanjifont {kanji16} \
|
|
|
158 -relief {raised} \
|
|
|
159 -text {States:}
|
|
|
160
|
|
|
161 # build widget .top0.frame1.button13
|
|
|
162 button .top0.frame1.button13 \
|
|
|
163 -activebackground {#eed5b7} \
|
|
|
164 -activeforeground {CornSilk2} \
|
|
|
165 -background {Cornsilk2} \
|
|
|
166 -command {# regexp {([0-9]+)x([0-9]+)} [wm geometry .] dm width height
|
|
|
167 # set height [expr $height-300]
|
|
|
168 # lite map $height
|
|
|
169 lite map 300
|
|
|
170 } \
|
|
|
171 -disabledforeground {#b0b0b0} \
|
|
|
172 -font {8x16} \
|
|
|
173 -kanjifont {kanji16} \
|
|
|
174 -text {Map}
|
|
|
175
|
|
|
176 # build widget .top0.frame1.button0
|
|
|
177 button .top0.frame1.button0 \
|
|
|
178 -activeforeground {CornSilk2} \
|
|
|
179 -background {Cornsilk2} \
|
|
|
180 -command {lite generate a} \
|
|
|
181 -font {8x16} \
|
|
|
182 -kanjifont {*-fixed-*-normal--16-*-jisx0208.1983-*} \
|
|
|
183 -text {Generate}
|
|
|
184
|
|
|
185 # pack widget .top0.frame1
|
|
|
186 pack append .top0.frame1 \
|
|
|
187 .top0.frame1.label6 {left frame center expand fillx} \
|
|
|
188 .top0.frame1.button13 {left frame center} \
|
|
|
189 .top0.frame1.button0 {left frame center fillx}
|
|
|
190
|
|
|
191 # build widget .top0.frame6
|
|
|
192 frame .top0.frame6 \
|
|
|
193 -background {Cornsilk2} \
|
|
|
194 -borderwidth {2} \
|
|
|
195 -relief {raised}
|
|
|
196
|
|
|
197 # build widget .top0.frame6.button8
|
|
|
198 button .top0.frame6.button8 \
|
|
|
199 -activebackground {#eed5b7} \
|
|
|
200 -activeforeground {CornSilk2} \
|
|
|
201 -background {Cornsilk2} \
|
|
|
202 -command {lite counter a} \
|
|
|
203 -disabledforeground {#b0b0b0} \
|
|
|
204 -font {8x16} \
|
|
|
205 -kanjifont {kanji16} \
|
|
|
206 -text {Counter Example}
|
|
|
207
|
|
|
208 # build widget .top0.frame6.button10
|
|
|
209 button .top0.frame6.button10 \
|
|
|
210 -activebackground {#eed5b7} \
|
|
|
211 -activeforeground {CornSilk2} \
|
|
|
212 -background {Cornsilk2} \
|
|
|
213 -command {lite execute a} \
|
|
|
214 -disabledforeground {#b0b0b0} \
|
|
|
215 -font {8x16} \
|
|
|
216 -kanjifont {kanji16} \
|
|
|
217 -text {Execute}
|
|
|
218
|
|
|
219 # build widget .top0.frame6.button9
|
|
|
220 button .top0.frame6.button9 \
|
|
|
221 -activebackground {#eed5b7} \
|
|
|
222 -activeforeground {CornSilk2} \
|
|
|
223 -background {Cornsilk2} \
|
|
|
224 -command {canvaswh .top0.frame0.canvas2 1.6} \
|
|
|
225 -disabledforeground {#b0b0b0} \
|
|
|
226 -font {8x16} \
|
|
|
227 -kanjifont {kanji16} \
|
|
|
228 -text {Enlarge}
|
|
|
229
|
|
|
230 # build widget .top0.frame6.button11
|
|
|
231 button .top0.frame6.button11 \
|
|
|
232 -activebackground {#eed5b7} \
|
|
|
233 -activeforeground {CornSilk2} \
|
|
|
234 -background {Cornsilk2} \
|
|
|
235 -command {canvaswh .top0.frame0.canvas2 0.625} \
|
|
|
236 -disabledforeground {#b0b0b0} \
|
|
|
237 -font {8x16} \
|
|
|
238 -kanjifont {kanji16} \
|
|
|
239 -text { Shrink}
|
|
|
240
|
|
|
241 # pack widget .top0.frame6
|
|
|
242 pack append .top0.frame6 \
|
|
|
243 .top0.frame6.button8 {right frame center fillx} \
|
|
|
244 .top0.frame6.button10 {right frame center expand fillx} \
|
|
|
245 .top0.frame6.button9 {left frame center} \
|
|
|
246 .top0.frame6.button11 {left frame center}
|
|
|
247
|
|
|
248 # pack widget .top0
|
|
|
249 pack append .top0 \
|
|
|
250 .top0.frame0 {bottom frame center expand fill} \
|
|
|
251 .top0.frame1 {bottom frame center fill} \
|
|
|
252 .top0.frame6 {top frame center fillx}
|
|
|
253
|
|
|
254 # build canvas items .top0.frame0.canvas2
|
|
|
255 set xfTmpTag [.top0.frame0.canvas2 create window -2480.03 -2615.93]
|
|
|
256 .top0.frame0.canvas2 itemconfigure $xfTmpTag \
|
|
|
257 -anchor {nw}
|
|
|
258 set xfTmpTag [.top0.frame0.canvas2 create line 326 189 326 199]
|
|
|
259 .top0.frame0.canvas2 itemconfigure $xfTmpTag \
|
|
|
260 -tags {cursol}
|
|
|
261 set xfTmpTag [.top0.frame0.canvas2 create line 321 194 331 194]
|
|
|
262 .top0.frame0.canvas2 itemconfigure $xfTmpTag \
|
|
|
263 -tags {cursol}
|
|
|
264
|
|
|
265
|
|
|
266
|
|
|
267 if {"[info procs XFEdit]" != ""} {
|
|
|
268 catch "XFMiscBindWidgetTree .top0"
|
|
|
269 after 2 "catch {XFEditSetShowWindows}"
|
|
|
270 }
|
|
|
271 }
|
|
|
272
|
|
|
273 proc DestroyWindow.top0 {} {# xf ignore me 7
|
|
|
274 if {"[info procs XFEdit]" != ""} {
|
|
|
275 if {"[info commands .top0]" != ""} {
|
|
|
276 global xfShowWindow.top0
|
|
|
277 set xfShowWindow.top0 0
|
|
|
278 XFEditSetPath .
|
|
|
279 after 2 "XFSaveAsProc .top0; XFEditSetShowWindows"
|
|
|
280 }
|
|
|
281 } {
|
|
|
282 catch "destroy .top0"
|
|
|
283 update
|
|
|
284 }
|
|
|
285 }
|
|
|
286
|
|
|
287
|
|
|
288 # procedure to show window .
|
|
|
289 proc ShowWindow. {args} {# xf ignore me 7
|
|
|
290
|
|
|
291 # Window manager configurations
|
|
|
292 global tkVersion
|
|
|
293 wm positionfrom . user
|
|
|
294 wm sizefrom . user
|
|
|
295 wm maxsize . 1280 1024
|
|
|
296 wm title . {Lite}
|
|
|
297
|
|
|
298
|
|
|
299 # build widget .frame
|
|
|
300 frame .frame \
|
|
|
301 -background {Cornsilk2} \
|
|
|
302 -relief {raised}
|
|
|
303
|
|
|
304 # build widget .frame.frame0
|
|
|
305 frame .frame.frame0 \
|
|
|
306 -background {Cornsilk2} \
|
|
|
307 -borderwidth {2} \
|
|
|
308 -relief {raised}
|
|
|
309
|
|
|
310 # build widget .frame.frame0.label4
|
|
|
311 label .frame.frame0.label4 \
|
|
|
312 -background {Cornsilk2} \
|
|
|
313 -font {8x16} \
|
|
|
314 -kanjifont {kanji16} \
|
|
|
315 -padx {2} \
|
|
|
316 -relief {raised} \
|
|
|
317 -text {ITL Formula:}
|
|
|
318
|
|
|
319 # build widget .frame.frame0.button3
|
|
|
320 button .frame.frame0.button3 \
|
|
|
321 -activebackground {#eed5b7} \
|
|
|
322 -activeforeground {CornSilk2} \
|
|
|
323 -background {Cornsilk2} \
|
|
|
324 -command {text_clear .frame.frame4.text0} \
|
|
|
325 -disabledforeground {#b0b0b0} \
|
|
|
326 -font {8x16} \
|
|
|
327 -kanjifont {*-fixed-*-normal--16-*-jisx0208.1983-*} \
|
|
|
328 -text {clear}
|
|
|
329
|
|
|
330 # build widget .frame.frame0.menubutton0
|
|
|
331 menubutton .frame.frame0.menubutton0 \
|
|
|
332 -activeforeground {CornSilk2} \
|
|
|
333 -background {Cornsilk2} \
|
|
|
334 -font {8x16} \
|
|
|
335 -kanjifont {*-fixed-*-normal--16-*-jisx0208.1983-*} \
|
|
|
336 -menu {.frame.frame0.menubutton0.m} \
|
|
|
337 -text {file}
|
|
|
338 # bindings
|
|
|
339 bind .frame.frame0.menubutton0 <Button-1> {MenuPopupPost .frame.frame0.menubutton0.m %X %Y}
|
|
|
340 bind .frame.frame0.menubutton0 <ButtonRelease-1> {MenuPopupRelease .frame.frame0.menubutton0.m %W}
|
|
|
341
|
|
|
342 # build widget .frame.frame0.menubutton0.m
|
|
|
343 menu .frame.frame0.menubutton0.m \
|
|
|
344 -activeforeground {CornSilk2} \
|
|
|
345 -background {Cornsilk2} \
|
|
|
346 -font {8x16} \
|
|
|
347 -kanjifont {*-fixed-*-normal--16-*-jisx0208.1983-*}
|
|
|
348 .frame.frame0.menubutton0.m add command \
|
|
|
349 -command {filehandling .frame.frame4.text0 load [FSBox "load"]} \
|
|
|
350 -label {load}
|
|
|
351 .frame.frame0.menubutton0.m add command \
|
|
|
352 -command {filehandling .frame.frame4.text0 save [FSBox "save"]} \
|
|
|
353 -label {save}
|
|
|
354 .frame.frame0.menubutton0.m add command \
|
|
|
355 -command {TokioCommand} \
|
|
|
356 -label {Tokio}
|
|
|
357 .frame.frame0.menubutton0.m add command \
|
|
|
358 -command {PrologCommand} \
|
|
|
359 -label {Prolog}
|
|
|
360 # bindings
|
|
|
361 bind .frame.frame0.menubutton0.m <Any-ButtonRelease-1> {MenuPopupRelease .frame.frame0.menubutton0.m %W}
|
|
|
362 bind .frame.frame0.menubutton0.m <Shift-Button-1> {MenuPopupPost .frame.frame0.menubutton0.m %X %Y}
|
|
|
363
|
|
|
364 # pack widget .frame.frame0
|
|
|
365 pack append .frame.frame0 \
|
|
|
366 .frame.frame0.label4 {left frame center expand fillx} \
|
|
|
367 .frame.frame0.button3 {right frame center} \
|
|
|
368 .frame.frame0.menubutton0 {left frame center fillx}
|
|
|
369
|
|
|
370 # build widget .frame.frame4
|
|
|
371 frame .frame.frame4 \
|
|
|
372 -background {Cornsilk2} \
|
|
|
373 -borderwidth {2} \
|
|
|
374 -relief {raised}
|
|
|
375
|
|
|
376 # build widget .frame.frame4.scrollbar1
|
|
|
377 scrollbar .frame.frame4.scrollbar1 \
|
|
|
378 -activeforeground {CornSilk2} \
|
|
|
379 -background {Cornsilk2} \
|
|
|
380 -command {.frame.frame4.text0 yview} \
|
|
|
381 -foreground {#ffe4c4}
|
|
|
382
|
|
|
383 # build widget .frame.frame4.text0
|
|
|
384 text .frame.frame4.text0 \
|
|
|
385 -background {Cornsilk2} \
|
|
|
386 -font {8x16} \
|
|
|
387 -kanjifont {kanji16} \
|
|
|
388 -height {10} \
|
|
|
389 -selectbackground {#b2dfee} \
|
|
|
390 -selectborderwidth {1} \
|
|
|
391 -selectforeground {CornSilk2} \
|
|
|
392 -width {61} \
|
|
|
393 -yscrollcommand {.frame.frame4.scrollbar1 set}
|
|
|
394 # bindings
|
|
|
395 bind .frame.frame4.text0 <Button-2> {%W mark set insert @%x,%y
|
|
|
396 %W insert insert [selection get]
|
|
|
397 %W yview -pickplace insert}
|
|
|
398 bind .frame.frame4.text0 <Button-3> {%W mark set anchor insert
|
|
|
399 %W tag add sel insert @%x,%y}
|
|
|
400 bind .frame.frame4.text0 <Control-Key-a> {%W mark set insert {insert linestart}}
|
|
|
401 bind .frame.frame4.text0 <Control-Key-b> {%W mark set insert {insert -1char}}
|
|
|
402 bind .frame.frame4.text0 <Control-Key-d> {%W delete insert}
|
|
|
403 bind .frame.frame4.text0 <Control-Key-e> {%W mark set insert {insert lineend}}
|
|
|
404 bind .frame.frame4.text0 <Control-Key-f> {%W mark set insert {insert +1char}}
|
|
|
405 bind .frame.frame4.text0 <Control-Key-k> {if ![string compare [%W get insert] "\n"] {
|
|
|
406 %W delete insert} else {
|
|
|
407 %W delete insert {insert lineend}
|
|
|
408 }}
|
|
|
409 bind .frame.frame4.text0 <Control-Key-n> {%W mark set insert {insert +1line}}
|
|
|
410 bind .frame.frame4.text0 <Control-Key-p> {%W mark set insert {insert -1line}}
|
|
|
411 bind .frame.frame4.text0 <Control-Key-w> {if [llength [%W tag ranges sel]] {
|
|
|
412 %W delete sel.first sel.last
|
|
|
413 }}
|
|
|
414
|
|
|
415 # pack widget .frame.frame4
|
|
|
416 pack append .frame.frame4 \
|
|
|
417 .frame.frame4.text0 {left frame center expand fill} \
|
|
|
418 .frame.frame4.scrollbar1 {right frame center filly}
|
|
|
419
|
|
|
420 # pack widget .frame
|
|
|
421 pack append .frame \
|
|
|
422 .frame.frame0 {top frame center fillx} \
|
|
|
423 .frame.frame4 {left frame center expand fill}
|
|
|
424
|
|
|
425 # build widget .frame3
|
|
|
426 frame .frame3 \
|
|
|
427 -background {Cornsilk2} \
|
|
|
428 -borderwidth {2} \
|
|
|
429 -relief {raised}
|
|
|
430
|
|
|
431 # build widget .frame3.button4
|
|
|
432 button .frame3.button4 \
|
|
|
433 -activebackground {#eed5b7} \
|
|
|
434 -activeforeground {CornSilk2} \
|
|
|
435 -background {Cornsilk2} \
|
|
|
436 -command {lite quit 0
|
|
|
437 destroy .} \
|
|
|
438 -disabledforeground {#b0b0b0} \
|
|
|
439 -font {8x16} \
|
|
|
440 -kanjifont {kanji16} \
|
|
|
441 -text {Quit}
|
|
|
442
|
|
|
443 # build widget .frame3.checkbutton5
|
|
|
444 checkbutton .frame3.checkbutton5 \
|
|
|
445 -activebackground {#eed5b7} \
|
|
|
446 -activeforeground {CornSilk2} \
|
|
|
447 -background {Cornsilk2} \
|
|
|
448 -command {lite verbose "$verbose"} \
|
|
|
449 -disabledforeground {#b0b0b0} \
|
|
|
450 -font {8x16} \
|
|
|
451 -kanjifont {kanji16} \
|
|
|
452 -selector {#b03060} \
|
|
|
453 -text {verbose} \
|
|
|
454 -variable {verbose}
|
|
|
455
|
|
|
456 # build widget .frame3.button7
|
|
|
457 button .frame3.button7 \
|
|
|
458 -activebackground {#eed5b7} \
|
|
|
459 -activeforeground {CornSilk2} \
|
|
|
460 -background {Cornsilk2} \
|
|
|
461 -command {lite verify "{[$symbolicName(entry) get 0.0 end]}"} \
|
|
|
462 -disabledforeground {#b0b0b0} \
|
|
|
463 -font {8x16} \
|
|
|
464 -kanjifont {kanji16} \
|
|
|
465 -text {Verify}
|
|
|
466
|
|
|
467 # pack widget .frame3
|
|
|
468 pack append .frame3 \
|
|
|
469 .frame3.button4 {left frame center} \
|
|
|
470 .frame3.checkbutton5 {right frame center} \
|
|
|
471 .frame3.button7 {top frame n fillx}
|
|
|
472
|
|
|
473 # pack widget .
|
|
|
474 pack append . \
|
|
|
475 .frame {top frame center expand fill} \
|
|
|
476 .frame3 {top frame center fill}
|
|
|
477
|
|
|
478 .frame.frame4.text0 insert end {}
|
|
|
479
|
|
|
480
|
|
|
481
|
|
|
482 if {"[info procs XFEdit]" != ""} {
|
|
|
483 catch "XFMiscBindWidgetTree ."
|
|
|
484 after 2 "catch {XFEditSetShowWindows}"
|
|
|
485 }
|
|
|
486 }
|
|
|
487
|
|
|
488
|
|
|
489 # User defined procedures
|
|
|
490
|
|
|
491
|
|
|
492 # Procedure: FSBox
|
|
|
493 proc FSBox { {fsBoxMessage "Select file:"} {fsBoxFileName ""} {fsBoxActionOk ""} {fsBoxActionCancel ""}} {
|
|
|
494 # xf ignore me 5
|
|
|
495 ##########
|
|
|
496 # Procedure: FSBox
|
|
|
497 # Description: show file selector box
|
|
|
498 # Arguments: fsBoxMessage - the text to display
|
|
|
499 # fsBoxFileName - a file name that should be selected
|
|
|
500 # fsBoxActionOk - the action that should be performed on ok
|
|
|
501 # fsBoxActionCancel - the action that should be performed on cancel
|
|
|
502 # Returns: the filename that was selected, or nothing
|
|
|
503 # Sideeffects: none
|
|
|
504 ##########
|
|
|
505 #
|
|
|
506 # global fsBox(activeBackground) - active background color
|
|
|
507 # global fsBox(activeForeground) - active foreground color
|
|
|
508 # global fsBox(background) - background color
|
|
|
509 # global fsBox(font) - text font
|
|
|
510 # global fsBox(foreground) - foreground color
|
|
|
511 # global fsBox(extensions) - scan directory for extensions
|
|
|
512 # global fsBox(scrollActiveForeground) - scrollbar active background color
|
|
|
513 # global fsBox(scrollBackground) - scrollbar background color
|
|
|
514 # global fsBox(scrollForeground) - scrollbar foreground color
|
|
|
515 # global fsBox(scrollSide) - side where scrollbar is located
|
|
|
516
|
|
|
517 global fsBox
|
|
|
518
|
|
|
519 set tmpButtonOpt ""
|
|
|
520 set tmpFrameOpt ""
|
|
|
521 set tmpMessageOpt ""
|
|
|
522 set tmpScaleOpt ""
|
|
|
523 set tmpScrollOpt ""
|
|
|
524 if {"$fsBox(activeBackground)" != ""} {
|
|
|
525 append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
|
|
|
526 }
|
|
|
527 if {"$fsBox(activeForeground)" != ""} {
|
|
|
528 append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
|
|
|
529 }
|
|
|
530 if {"$fsBox(background)" != ""} {
|
|
|
531 append tmpButtonOpt "-background \"$fsBox(background)\" "
|
|
|
532 append tmpFrameOpt "-background \"$fsBox(background)\" "
|
|
|
533 append tmpMessageOpt "-background \"$fsBox(background)\" "
|
|
|
534 }
|
|
|
535 if {"$fsBox(font)" != ""} {
|
|
|
536 append tmpButtonOpt "-font \"$fsBox(font)\" "
|
|
|
537 append tmpMessageOpt "-font \"$fsBox(font)\" "
|
|
|
538 }
|
|
|
539 if {"$fsBox(foreground)" != ""} {
|
|
|
540 append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
|
|
|
541 append tmpMessageOpt "-foreground \"$fsBox(foreground)\" "
|
|
|
542 }
|
|
|
543 if {"$fsBox(scrollActiveForeground)" != ""} {
|
|
|
544 append tmpScrollOpt "-activeforeground \"$fsBox(scrollActiveForeground)\" "
|
|
|
545 }
|
|
|
546 if {"$fsBox(scrollBackground)" != ""} {
|
|
|
547 append tmpScrollOpt "-background \"$fsBox(scrollBackground)\" "
|
|
|
548 }
|
|
|
549 if {"$fsBox(scrollForeground)" != ""} {
|
|
|
550 append tmpScrollOpt "-foreground \"$fsBox(scrollForeground)\" "
|
|
|
551 }
|
|
|
552
|
|
|
553 if {[file exists [file tail $fsBoxFileName]] &&
|
|
|
554 [IsAFile [file tail $fsBoxFileName]]} {
|
|
|
555 set fsBox(name) [file tail $fsBoxFileName]
|
|
|
556 } {
|
|
|
557 set fsBox(name) ""
|
|
|
558 }
|
|
|
559 if {[file exists $fsBoxFileName] && [IsADir $fsBoxFileName]} {
|
|
|
560 set fsBox(path) $fsBoxFileName
|
|
|
561 } {
|
|
|
562 if {"[file rootname $fsBoxFileName]" != "."} {
|
|
|
563 set fsBox(path) [file rootname $fsBoxFileName]
|
|
|
564 }
|
|
|
565 }
|
|
|
566 if {$fsBox(showPixmap)} {
|
|
|
567 set fsBox(path) [string trimleft $fsBox(path) @]
|
|
|
568 }
|
|
|
569 if {"$fsBox(path)" != "" && [file exists $fsBox(path)] &&
|
|
|
570 [IsADir $fsBox(path)]} {
|
|
|
571 set fsBox(internalPath) $fsBox(path)
|
|
|
572 } {
|
|
|
573 if {"$fsBox(internalPath)" == "" ||
|
|
|
574 ![file exists $fsBox(internalPath)]} {
|
|
|
575 set fsBox(internalPath) [pwd]
|
|
|
576 }
|
|
|
577 }
|
|
|
578 # build widget structure
|
|
|
579
|
|
|
580 # start build of toplevel
|
|
|
581 if {"[info commands XFDestroy]" != ""} {
|
|
|
582 catch {XFDestroy .fsBox}
|
|
|
583 } {
|
|
|
584 catch {destroy .fsBox}
|
|
|
585 }
|
|
|
586 toplevel .fsBox -borderwidth 0
|
|
|
587 catch ".fsBox config $tmpFrameOpt"
|
|
|
588 wm geometry .fsBox 350x300
|
|
|
589 wm title .fsBox {File select box}
|
|
|
590 wm maxsize .fsBox 1000 1000
|
|
|
591 wm minsize .fsBox 100 100
|
|
|
592 # end build of toplevel
|
|
|
593
|
|
|
594 label .fsBox.message1 -anchor c -relief raised -text "$fsBoxMessage"
|
|
|
595 catch ".fsBox.message1 config $tmpMessageOpt"
|
|
|
596
|
|
|
597 frame .fsBox.frame1 -borderwidth 0 -relief raised
|
|
|
598 catch ".fsBox.frame1 config $tmpFrameOpt"
|
|
|
599
|
|
|
600 button .fsBox.frame1.ok -text "OK" -command "
|
|
|
601 global fsBox
|
|
|
602 set fsBox(name) \[.fsBox.file.file get\]
|
|
|
603 if {$fsBox(showPixmap)} {
|
|
|
604 set fsBox(path) @\[.fsBox.path.path get\]
|
|
|
605 } {
|
|
|
606 set fsBox(path) \[.fsBox.path.path get\]
|
|
|
607 }
|
|
|
608 set fsBox(internalPath) \[.fsBox.path.path get\]
|
|
|
609 $fsBoxActionOk
|
|
|
610 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
611 catch {XFDestroy .fsBox}
|
|
|
612 } {
|
|
|
613 catch {destroy .fsBox}
|
|
|
614 }"
|
|
|
615 catch ".fsBox.frame1.ok config $tmpButtonOpt"
|
|
|
616
|
|
|
617 button .fsBox.frame1.rescan -text "Rescan" -command {
|
|
|
618 global fsBox
|
|
|
619 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)}
|
|
|
620 catch ".fsBox.frame1.rescan config $tmpButtonOpt"
|
|
|
621
|
|
|
622 button .fsBox.frame1.cancel -text "Cancel" -command "
|
|
|
623 global fsBox
|
|
|
624 set fsBox(name) {}
|
|
|
625 set fsBox(path) {}
|
|
|
626 $fsBoxActionCancel
|
|
|
627 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
628 catch {XFDestroy .fsBox}
|
|
|
629 } {
|
|
|
630 catch {destroy .fsBox}
|
|
|
631 }"
|
|
|
632 catch ".fsBox.frame1.cancel config $tmpButtonOpt"
|
|
|
633
|
|
|
634 if {$fsBox(showPixmap)} {
|
|
|
635 frame .fsBox.frame2 -borderwidth 0 -relief raised
|
|
|
636 catch ".fsBox.frame2 config $tmpFrameOpt"
|
|
|
637
|
|
|
638 scrollbar .fsBox.frame2.scrollbar3 -command {.fsBox.frame2.canvas2 xview} -orient {horizontal} -relief {raised}
|
|
|
639 catch ".fsBox.frame2.scrollbar3 config $tmpScrollOpt"
|
|
|
640
|
|
|
641 scrollbar .fsBox.frame2.scrollbar1 -command {.fsBox.frame2.canvas2 yview} -relief {raised}
|
|
|
642 catch ".fsBox.frame2.scrollbar1 config $tmpScrollOpt"
|
|
|
643
|
|
|
644 canvas .fsBox.frame2.canvas2 -confine {true} -relief {raised} -scrollregion {0c 0c 20c 20c} -width {100} -xscrollcommand {.fsBox.frame2.scrollbar3 set} -yscrollcommand {.fsBox.frame2.scrollbar1 set}
|
|
|
645 catch ".fsBox.frame2.canvas2 config $tmpFrameOpt"
|
|
|
646
|
|
|
647 .fsBox.frame2.canvas2 addtag currentBitmap withtag [.fsBox.frame2.canvas2 create bitmap 5 5 -anchor nw]
|
|
|
648 }
|
|
|
649
|
|
|
650 frame .fsBox.path -borderwidth 0 -relief raised
|
|
|
651 catch ".fsBox.path config $tmpFrameOpt"
|
|
|
652
|
|
|
653 frame .fsBox.path.paths -borderwidth 2 -relief raised
|
|
|
654 catch ".fsBox.path.paths config $tmpFrameOpt"
|
|
|
655
|
|
|
656 menubutton .fsBox.path.paths.paths -borderwidth 0 -menu ".fsBox.path.paths.paths.menu" -relief flat -text "Pathname:"
|
|
|
657 catch ".fsBox.path.paths.paths config $tmpButtonOpt"
|
|
|
658
|
|
|
659 menu .fsBox.path.paths.paths.menu
|
|
|
660 catch ".fsBox.path.paths.paths.menu config $tmpButtonOpt"
|
|
|
661
|
|
|
662 .fsBox.path.paths.paths.menu add command -label "[string trimright $fsBox(internalPath) {/@}]" -command "
|
|
|
663 global fsBox
|
|
|
664 FSBoxFSShow \[.fsBox.path.path get\] \[.fsBox.pattern.pattern get\] \$fsBox(all)
|
|
|
665 .fsBox.path.path delete 0 end
|
|
|
666 .fsBox.path.path insert 0 [string trimright $fsBox(internalPath) {/@}]"
|
|
|
667
|
|
|
668 entry .fsBox.path.path -relief raised
|
|
|
669 catch ".fsBox.path.path config $tmpMessageOpt"
|
|
|
670
|
|
|
671 if {![IsADir $fsBox(internalPath)]} {
|
|
|
672 set $fsBox(internalPath) [pwd]
|
|
|
673 }
|
|
|
674 .fsBox.path.path insert 0 $fsBox(internalPath)
|
|
|
675
|
|
|
676 frame .fsBox.pattern -borderwidth 0 -relief raised
|
|
|
677 catch ".fsBox.pattern config $tmpFrameOpt"
|
|
|
678
|
|
|
679 frame .fsBox.pattern.patterns -borderwidth 2 -relief raised
|
|
|
680 catch ".fsBox.pattern.patterns config $tmpFrameOpt"
|
|
|
681
|
|
|
682 menubutton .fsBox.pattern.patterns.patterns -borderwidth 0 -menu ".fsBox.pattern.patterns.patterns.menu" -relief flat -text "Selection pattern:"
|
|
|
683 catch ".fsBox.pattern.patterns.patterns config $tmpButtonOpt"
|
|
|
684
|
|
|
685 menu .fsBox.pattern.patterns.patterns.menu
|
|
|
686 catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"
|
|
|
687
|
|
|
688 .fsBox.pattern.patterns.patterns.menu add checkbutton -label "Scan extensions" -variable fsBox(extensions) -command {
|
|
|
689 global fsBox
|
|
|
690 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)}
|
|
|
691
|
|
|
692 entry .fsBox.pattern.pattern -relief raised
|
|
|
693 catch ".fsBox.pattern.pattern config $tmpMessageOpt"
|
|
|
694
|
|
|
695 .fsBox.pattern.pattern insert 0 $fsBox(pattern)
|
|
|
696
|
|
|
697 frame .fsBox.files -borderwidth 0 -relief raised
|
|
|
698 catch ".fsBox.files config $tmpFrameOpt"
|
|
|
699
|
|
|
700 scrollbar .fsBox.files.vscroll -relief raised -command ".fsBox.files.files yview"
|
|
|
701 catch ".fsBox.files.vscroll config $tmpScrollOpt"
|
|
|
702
|
|
|
703 scrollbar .fsBox.files.hscroll -orient horiz -relief raised -command ".fsBox.files.files xview"
|
|
|
704 catch ".fsBox.files.hscroll config $tmpScrollOpt"
|
|
|
705
|
|
|
706 listbox .fsBox.files.files -exportselection false -relief raised -xscrollcommand ".fsBox.files.hscroll set" -yscrollcommand ".fsBox.files.vscroll set"
|
|
|
707 catch ".fsBox.files.files config $tmpMessageOpt"
|
|
|
708
|
|
|
709 frame .fsBox.file -borderwidth 0 -relief raised
|
|
|
710 catch ".fsBox.file config $tmpFrameOpt"
|
|
|
711
|
|
|
712 label .fsBox.file.labelfile -relief raised -text "Filename:"
|
|
|
713 catch ".fsBox.file.labelfile config $tmpMessageOpt"
|
|
|
714
|
|
|
715 entry .fsBox.file.file -relief raised
|
|
|
716 catch ".fsBox.file.file config $tmpMessageOpt"
|
|
|
717
|
|
|
718 .fsBox.file.file delete 0 end
|
|
|
719 .fsBox.file.file insert 0 $fsBox(name)
|
|
|
720
|
|
|
721 checkbutton .fsBox.pattern.all -offvalue 0 -onvalue 1 -text "Show all files" -variable fsBox(all) -command {
|
|
|
722 global fsBox
|
|
|
723 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)}
|
|
|
724 catch ".fsBox.pattern.all config $tmpButtonOpt"
|
|
|
725
|
|
|
726 FSBoxFSShow $fsBox(internalPath) $fsBox(pattern) $fsBox(all)
|
|
|
727
|
|
|
728 # bindings
|
|
|
729 bind .fsBox.files.files <Double-Button-1> "
|
|
|
730 FSBoxFSFileSelectDouble %W $fsBox(showPixmap) \{$fsBoxActionOk\} %y"
|
|
|
731 bind .fsBox.files.files <ButtonPress-1> "
|
|
|
732 FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
|
|
|
733 bind .fsBox.files.files <Button1-Motion> "
|
|
|
734 FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
|
|
|
735 bind .fsBox.files.files <Shift-Button1-Motion> "
|
|
|
736 FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
|
|
|
737 bind .fsBox.files.files <Shift-ButtonPress-1> "
|
|
|
738 FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
|
|
|
739
|
|
|
740 bind .fsBox.path.path <Tab> {
|
|
|
741 FSBoxFSNameComplete path}
|
|
|
742 bind .fsBox.path.path <Return> {
|
|
|
743 global tkVersion
|
|
|
744 global fsBox
|
|
|
745 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)
|
|
|
746 FSBoxFSInsertPath
|
|
|
747 if {$tkVersion >= 3.0} {
|
|
|
748 .fsBox.file.file icursor end
|
|
|
749 } {
|
|
|
750 .fsBox.file.file cursor end
|
|
|
751 }
|
|
|
752 focus .fsBox.file.file}
|
|
|
753 catch "bind .fsBox.path.path <Up> {}"
|
|
|
754 bind .fsBox.path.path <Down> {
|
|
|
755 global tkVersion
|
|
|
756 if {$tkVersion >= 3.0} {
|
|
|
757 .fsBox.file.file icursor end
|
|
|
758 } {
|
|
|
759 .fsBox.file.file cursor end
|
|
|
760 }
|
|
|
761 focus .fsBox.file.file}
|
|
|
762
|
|
|
763 bind .fsBox.file.file <Tab> {
|
|
|
764 FSBoxFSNameComplete file}
|
|
|
765 bind .fsBox.file.file <Return> "
|
|
|
766 global fsBox
|
|
|
767 set fsBox(name) \[.fsBox.file.file get\]
|
|
|
768 if {$fsBox(showPixmap)} {
|
|
|
769 set fsBox(path) @\[.fsBox.path.path get\]
|
|
|
770 } {
|
|
|
771 set fsBox(path) \[.fsBox.path.path get\]
|
|
|
772 }
|
|
|
773 set fsBox(internalPath) \[.fsBox.path.path get\]
|
|
|
774 $fsBoxActionOk
|
|
|
775 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
776 catch {XFDestroy .fsBox}
|
|
|
777 } {
|
|
|
778 catch {destroy .fsBox}
|
|
|
779 }"
|
|
|
780 bind .fsBox.file.file <Up> {
|
|
|
781 global tkVersion
|
|
|
782 if {$tkVersion >= 3.0} {
|
|
|
783 .fsBox.path.path icursor end
|
|
|
784 } {
|
|
|
785 .fsBox.path.path cursor end
|
|
|
786 }
|
|
|
787 focus .fsBox.path.path}
|
|
|
788 bind .fsBox.file.file <Down> {
|
|
|
789 global tkVersion
|
|
|
790 if {$tkVersion >= 3.0} {
|
|
|
791 .fsBox.pattern.pattern icursor end
|
|
|
792 } {
|
|
|
793 .fsBox.pattern.pattern cursor end
|
|
|
794 }
|
|
|
795 focus .fsBox.pattern.pattern}
|
|
|
796
|
|
|
797 bind .fsBox.pattern.pattern <Return> {
|
|
|
798 global fsBox
|
|
|
799 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)}
|
|
|
800 bind .fsBox.pattern.pattern <Up> {
|
|
|
801 global tkVersion
|
|
|
802 if {$tkVersion >= 3.0} {
|
|
|
803 .fsBox.file.file icursor end
|
|
|
804 } {
|
|
|
805 .fsBox.file.file cursor end
|
|
|
806 }
|
|
|
807 focus .fsBox.file.file}
|
|
|
808 catch "bind .fsBox.pattern.pattern <Down> {}"
|
|
|
809
|
|
|
810 # packing
|
|
|
811 pack append .fsBox.files .fsBox.files.vscroll "$fsBox(scrollSide) filly" .fsBox.files.hscroll {bottom fillx} .fsBox.files.files {left fill expand}
|
|
|
812 pack append .fsBox.file .fsBox.file.labelfile {left} .fsBox.file.file {left fill expand}
|
|
|
813 pack append .fsBox.frame1 .fsBox.frame1.ok {left fill expand} .fsBox.frame1.rescan {left fill expand} .fsBox.frame1.cancel {left fill expand}
|
|
|
814 pack append .fsBox.path.paths .fsBox.path.paths.paths {left}
|
|
|
815 pack append .fsBox.pattern.patterns .fsBox.pattern.patterns.patterns {left}
|
|
|
816 pack append .fsBox.path .fsBox.path.paths {left} .fsBox.path.path {left fill expand}
|
|
|
817 pack append .fsBox.pattern .fsBox.pattern.patterns {left} .fsBox.pattern.all {right fill} .fsBox.pattern.pattern {left fill expand}
|
|
|
818 if {$fsBox(showPixmap)} {
|
|
|
819 pack append .fsBox.frame2 .fsBox.frame2.scrollbar1 {left filly} .fsBox.frame2.canvas2 {top expand fill} .fsBox.frame2.scrollbar3 {top fillx}
|
|
|
820
|
|
|
821 pack append .fsBox .fsBox.message1 {top fill} .fsBox.frame1 {bottom fill} .fsBox.pattern {bottom fill} .fsBox.file {bottom fill} .fsBox.path {bottom fill} .fsBox.frame2 {right fill} .fsBox.files {left fill expand}
|
|
|
822 } {
|
|
|
823 pack append .fsBox .fsBox.message1 {top fill} .fsBox.frame1 {bottom fill} .fsBox.pattern {bottom fill} .fsBox.file {bottom fill} .fsBox.path {bottom fill} .fsBox.files {left fill expand}
|
|
|
824 }
|
|
|
825
|
|
|
826 if {"$fsBoxActionOk" == "" && "$fsBoxActionCancel" == ""} {
|
|
|
827 # wait for the box to be destroyed
|
|
|
828 update idletask
|
|
|
829 grab .fsBox
|
|
|
830 tkwait window .fsBox
|
|
|
831
|
|
|
832 if {"[string trim $fsBox(path)]" != "" ||
|
|
|
833 "[string trim $fsBox(name)]" != ""} {
|
|
|
834 if {"[string trimleft [string trim $fsBox(name)] /]" == ""} {
|
|
|
835 return [string trimright [string trim $fsBox(path)] /]
|
|
|
836 } {
|
|
|
837 return [string trimright [string trim $fsBox(path)] /]/[string trimleft [string trim $fsBox(name)] /]
|
|
|
838 }
|
|
|
839 }
|
|
|
840 }
|
|
|
841 }
|
|
|
842
|
|
|
843
|
|
|
844 # Procedure: FSBoxBindSelectOne
|
|
|
845 proc FSBoxBindSelectOne { fsBoxW fsBoxY} {
|
|
|
846 # xf ignore me 6
|
|
|
847
|
|
|
848 set fsBoxNearest [$fsBoxW nearest $fsBoxY]
|
|
|
849 if {$fsBoxNearest >= 0} {
|
|
|
850 $fsBoxW select from $fsBoxNearest
|
|
|
851 $fsBoxW select to $fsBoxNearest
|
|
|
852 }
|
|
|
853 }
|
|
|
854
|
|
|
855
|
|
|
856 # Procedure: FSBoxFSFileSelect
|
|
|
857 proc FSBoxFSFileSelect { fsBoxW fsBoxShowPixmap fsBoxY} {
|
|
|
858 # xf ignore me 6
|
|
|
859 global fsBox
|
|
|
860
|
|
|
861 FSBoxBindSelectOne $fsBoxW $fsBoxY
|
|
|
862 set fsBoxNearest [$fsBoxW nearest $fsBoxY]
|
|
|
863 if {$fsBoxNearest >= 0} {
|
|
|
864 set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
|
|
|
865 if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
|
|
|
866 "[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
|
|
|
867 set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]]
|
|
|
868 if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
|
|
|
869 ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
|
|
|
870 set fsBoxFileName $fsBoxTmpEntry
|
|
|
871 }
|
|
|
872 } {
|
|
|
873 if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
|
|
|
874 set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]]
|
|
|
875 if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
|
|
|
876 set fsBoxFileName $fsBoxTmpEntry
|
|
|
877 }
|
|
|
878 } {
|
|
|
879 set fsBoxFileName $fsBoxTmpEntry
|
|
|
880 }
|
|
|
881 }
|
|
|
882 if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
|
|
|
883 set fsBox(name) $fsBoxFileName
|
|
|
884 .fsBox.file.file delete 0 end
|
|
|
885 .fsBox.file.file insert 0 $fsBox(name)
|
|
|
886 if {$fsBoxShowPixmap} {
|
|
|
887 catch ".fsBox.frame2.canvas2 itemconfigure currentBitmap -bitmap \"@$fsBox(internalPath)/$fsBox(name)\""
|
|
|
888 }
|
|
|
889 }
|
|
|
890 }
|
|
|
891 }
|
|
|
892
|
|
|
893
|
|
|
894 # Procedure: FSBoxFSFileSelectDouble
|
|
|
895 proc FSBoxFSFileSelectDouble { fsBoxW fsBoxShowPixmap fsBoxAction fsBoxY} {
|
|
|
896 # xf ignore me 6
|
|
|
897 global fsBox
|
|
|
898
|
|
|
899 FSBoxBindSelectOne $fsBoxW $fsBoxY
|
|
|
900 set fsBoxNearest [$fsBoxW nearest $fsBoxY]
|
|
|
901 if {$fsBoxNearest >= 0} {
|
|
|
902 set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
|
|
|
903 if {"$fsBoxTmpEntry" == "../"} {
|
|
|
904 set fsBoxTmpEntry [string trimright [string trim $fsBox(internalPath)] "@/"]
|
|
|
905 if {"$fsBoxTmpEntry" == ""} {
|
|
|
906 return
|
|
|
907 }
|
|
|
908 FSBoxFSShow [file dirname $fsBoxTmpEntry] [.fsBox.pattern.pattern get] $fsBox(all)
|
|
|
909 .fsBox.path.path delete 0 end
|
|
|
910 .fsBox.path.path insert 0 $fsBox(internalPath)
|
|
|
911 } {
|
|
|
912 if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
|
|
|
913 "[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
|
|
|
914 set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]]
|
|
|
915 if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
|
|
|
916 ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
|
|
|
917 set fsBoxFileName $fsBoxTmpEntry
|
|
|
918 }
|
|
|
919 } {
|
|
|
920 if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
|
|
|
921 set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]]
|
|
|
922 if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
|
|
|
923 set fsBoxFileName $fsBoxTmpEntry
|
|
|
924 }
|
|
|
925 } {
|
|
|
926 set fsBoxFileName $fsBoxTmpEntry
|
|
|
927 }
|
|
|
928 }
|
|
|
929 if {[IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
|
|
|
930 set fsBox(internalPath) "[string trimright $fsBox(internalPath) {/@}]/$fsBoxFileName"
|
|
|
931 FSBoxFSShow $fsBox(internalPath) [.fsBox.pattern.pattern get] $fsBox(all)
|
|
|
932 .fsBox.path.path delete 0 end
|
|
|
933 .fsBox.path.path insert 0 $fsBox(internalPath)
|
|
|
934 } {
|
|
|
935 set fsBox(name) $fsBoxFileName
|
|
|
936 if {$fsBoxShowPixmap} {
|
|
|
937 set fsBox(path) @$fsBox(internalPath)
|
|
|
938 } {
|
|
|
939 set fsBox(path) $fsBox(internalPath)
|
|
|
940 }
|
|
|
941 if {"$fsBoxAction" != ""} {
|
|
|
942 eval "global fsBox; $fsBoxAction"
|
|
|
943 }
|
|
|
944 if {"[info commands XFDestroy]" != ""} {
|
|
|
945 catch {XFDestroy .fsBox}
|
|
|
946 } {
|
|
|
947 catch {destroy .fsBox}
|
|
|
948 }
|
|
|
949 }
|
|
|
950 }
|
|
|
951 }
|
|
|
952 }
|
|
|
953
|
|
|
954
|
|
|
955 # Procedure: FSBoxFSInsertPath
|
|
|
956 proc FSBoxFSInsertPath {} {
|
|
|
957 # xf ignore me 6
|
|
|
958 global fsBox
|
|
|
959
|
|
|
960 set fsBoxLast [.fsBox.path.paths.paths.menu index last]
|
|
|
961 set fsBoxNewEntry [string trimright [.fsBox.path.path get] "/@"]
|
|
|
962 for {set fsBoxCounter 0} {$fsBoxCounter <= $fsBoxLast} {incr fsBoxCounter 1} {
|
|
|
963 if {"$fsBoxNewEntry" == "[lindex [.fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -label] 4]"} {
|
|
|
964 return
|
|
|
965 }
|
|
|
966 }
|
|
|
967 if {$fsBoxLast < 9} {
|
|
|
968 .fsBox.path.paths.paths.menu add command -label "$fsBoxNewEntry" -command "
|
|
|
969 global fsBox
|
|
|
970 FSBoxFSShow $fsBoxNewEntry \[.fsBox.pattern.pattern get\] \$fsBox(all)
|
|
|
971 .fsBox.path.path delete 0 end
|
|
|
972 .fsBox.path.path insert 0 $fsBoxNewEntry"
|
|
|
973 } {
|
|
|
974 for {set fsBoxCounter 0} {$fsBoxCounter < $fsBoxLast} {incr fsBoxCounter 1} {
|
|
|
975 .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -label [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4]
|
|
|
976 .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -command "
|
|
|
977 global fsBox
|
|
|
978 FSBoxFSShow [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4] \[.fsBox.pattern.pattern get\] \$fsBox(all)
|
|
|
979 .fsBox.path.path delete 0 end
|
|
|
980 .fsBox.path.path insert 0 [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4]"
|
|
|
981 }
|
|
|
982 .fsBox.path.paths.paths.menu entryconfigure $fsBoxLast -label "$fsBoxNewEntry"
|
|
|
983 .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -command "
|
|
|
984 global fsBox
|
|
|
985 FSBoxFSShow \[.fsBox.path.path get\] \[.fsBox.pattern.pattern get\] \$fsBox(all)
|
|
|
986 .fsBox.path.path delete 0 end
|
|
|
987 .fsBox.path.path insert 0 $fsBoxNewEntry"
|
|
|
988 }
|
|
|
989 }
|
|
|
990
|
|
|
991
|
|
|
992 # Procedure: FSBoxFSNameComplete
|
|
|
993 proc FSBoxFSNameComplete { fsBoxType} {
|
|
|
994 # xf ignore me 6
|
|
|
995 global tkVersion
|
|
|
996 global fsBox
|
|
|
997
|
|
|
998 set fsBoxNewFile ""
|
|
|
999 if {"$fsBoxType" == "path"} {
|
|
|
1000 set fsBoxDirName [file dirname [.fsBox.path.path get]]
|
|
|
1001 set fsBoxFileName [file tail [.fsBox.path.path get]]
|
|
|
1002 } {
|
|
|
1003 set fsBoxDirName [file dirname [.fsBox.path.path get]/]
|
|
|
1004 set fsBoxFileName [file tail [.fsBox.file.file get]]
|
|
|
1005 }
|
|
|
1006
|
|
|
1007 set fsBoxNewFile ""
|
|
|
1008 if {[IsADir [string trimright $fsBoxDirName @]]} {
|
|
|
1009 catch "glob -nocomplain $fsBoxDirName/${fsBoxFileName}*" fsBoxResult
|
|
|
1010 foreach fsBoxCounter $fsBoxResult {
|
|
|
1011 if {"$fsBoxNewFile" == ""} {
|
|
|
1012 set fsBoxNewFile [file tail $fsBoxCounter]
|
|
|
1013 } {
|
|
|
1014 if {"[string index [file tail $fsBoxCounter] 0]" !=
|
|
|
1015 "[string index $fsBoxNewFile 0]"} {
|
|
|
1016 set fsBoxNewFile ""
|
|
|
1017 break
|
|
|
1018 }
|
|
|
1019 set fsBoxCounter1 0
|
|
|
1020 set fsBoxTmpFile1 $fsBoxNewFile
|
|
|
1021 set fsBoxTmpFile2 [file tail $fsBoxCounter]
|
|
|
1022 set fsBoxLength1 [string length $fsBoxTmpFile1]
|
|
|
1023 set fsBoxLength2 [string length $fsBoxTmpFile2]
|
|
|
1024 set fsBoxNewFile ""
|
|
|
1025 if {$fsBoxLength1 > $fsBoxLength2} {
|
|
|
1026 set fsBoxLength1 $fsBoxLength2
|
|
|
1027 }
|
|
|
1028 while {$fsBoxCounter1 < $fsBoxLength1} {
|
|
|
1029 if {"[string index $fsBoxTmpFile1 $fsBoxCounter1]" == "[string index $fsBoxTmpFile2 $fsBoxCounter1]"} {
|
|
|
1030 append fsBoxNewFile [string index $fsBoxTmpFile1 $fsBoxCounter1]
|
|
|
1031 } {
|
|
|
1032 break
|
|
|
1033 }
|
|
|
1034 incr fsBoxCounter1 1
|
|
|
1035 }
|
|
|
1036 }
|
|
|
1037 }
|
|
|
1038 }
|
|
|
1039 if {"$fsBoxNewFile" != ""} {
|
|
|
1040 if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]] ||
|
|
|
1041 ![IsAFile [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
|
|
|
1042 if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
|
|
|
1043 if {"$fsBoxDirName" == "/"} {
|
|
|
1044 .fsBox.path.path delete 0 end
|
|
|
1045 .fsBox.path.path insert 0 "/[string trimright [string trim $fsBoxNewFile /] @]/"
|
|
|
1046 } {
|
|
|
1047 .fsBox.path.path delete 0 end
|
|
|
1048 .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]/"
|
|
|
1049 }
|
|
|
1050 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)
|
|
|
1051 FSBoxFSInsertPath
|
|
|
1052 } {
|
|
|
1053 .fsBox.path.path delete 0 end
|
|
|
1054 .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]"
|
|
|
1055 }
|
|
|
1056 } {
|
|
|
1057 .fsBox.path.path delete 0 end
|
|
|
1058 .fsBox.path.path insert 0 "[string trimright $fsBoxDirName {@/}]/"
|
|
|
1059 .fsBox.file.file delete 0 end
|
|
|
1060 .fsBox.file.file insert 0 $fsBoxNewFile
|
|
|
1061 if {$tkVersion >= 3.0} {
|
|
|
1062 .fsBox.file.file icursor end
|
|
|
1063 } {
|
|
|
1064 .fsBox.file.file cursor end
|
|
|
1065 }
|
|
|
1066 focus .fsBox.file.file
|
|
|
1067 }
|
|
|
1068 }
|
|
|
1069 }
|
|
|
1070
|
|
|
1071
|
|
|
1072 # Procedure: FSBoxFSShow
|
|
|
1073 proc FSBoxFSShow { fsBoxPath fsBoxPattern fsBoxAll} {
|
|
|
1074 # xf ignore me 6
|
|
|
1075 global fsBox
|
|
|
1076
|
|
|
1077 set tmpButtonOpt ""
|
|
|
1078 if {"$fsBox(activeBackground)" != ""} {
|
|
|
1079 append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
|
|
|
1080 }
|
|
|
1081 if {"$fsBox(activeForeground)" != ""} {
|
|
|
1082 append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
|
|
|
1083 }
|
|
|
1084 if {"$fsBox(background)" != ""} {
|
|
|
1085 append tmpButtonOpt "-background \"$fsBox(background)\" "
|
|
|
1086 }
|
|
|
1087 if {"$fsBox(font)" != ""} {
|
|
|
1088 append tmpButtonOpt "-font \"$fsBox(font)\" "
|
|
|
1089 }
|
|
|
1090 if {"$fsBox(foreground)" != ""} {
|
|
|
1091 append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
|
|
|
1092 }
|
|
|
1093
|
|
|
1094 set fsBox(pattern) $fsBoxPattern
|
|
|
1095 if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
|
|
|
1096 [IsADir $fsBoxPath]} {
|
|
|
1097 set fsBox(internalPath) $fsBoxPath
|
|
|
1098 } {
|
|
|
1099 if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
|
|
|
1100 [IsAFile $fsBoxPath]} {
|
|
|
1101 set fsBox(internalPath) [file dirname $fsBoxPath]
|
|
|
1102 .fsBox.file.file delete 0 end
|
|
|
1103 .fsBox.file.file insert 0 [file tail $fsBoxPath]
|
|
|
1104 set fsBoxPath $fsBox(internalPath)
|
|
|
1105 } {
|
|
|
1106 while {"$fsBoxPath" != "" && "$fsBoxPath" != "/" &&
|
|
|
1107 ![file isdirectory $fsBoxPath]} {
|
|
|
1108 set fsBox(internalPath) [file dirname $fsBoxPath]
|
|
|
1109 set fsBoxPath $fsBox(internalPath)
|
|
|
1110 }
|
|
|
1111 }
|
|
|
1112 }
|
|
|
1113 if {"$fsBoxPath" == ""} {
|
|
|
1114 set fsBoxPath "/"
|
|
|
1115 set fsBox(internalPath) "/"
|
|
|
1116 }
|
|
|
1117 .fsBox.path.path delete 0 end
|
|
|
1118 .fsBox.path.path insert 0 $fsBox(internalPath)
|
|
|
1119
|
|
|
1120 if {[.fsBox.files.files size] > 0} {
|
|
|
1121 .fsBox.files.files delete 0 end
|
|
|
1122 }
|
|
|
1123 if {$fsBoxAll} {
|
|
|
1124 if {[catch "exec ls -F -a $fsBoxPath" fsBoxResult]} {
|
|
|
1125 puts stderr "$fsBoxResult"
|
|
|
1126 }
|
|
|
1127 } {
|
|
|
1128 if {[catch "exec ls -F $fsBoxPath" fsBoxResult]} {
|
|
|
1129 puts stderr "$fsBoxResult"
|
|
|
1130 }
|
|
|
1131 }
|
|
|
1132 set fsBoxElementList [lsort $fsBoxResult]
|
|
|
1133
|
|
|
1134 foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] {
|
|
|
1135 if {[string length [info commands XFDestroy]] > 0} {
|
|
|
1136 catch {XFDestroy $fsBoxCounter}
|
|
|
1137 } {
|
|
|
1138 catch {destroy $fsBoxCounter}
|
|
|
1139 }
|
|
|
1140 }
|
|
|
1141 menu .fsBox.pattern.patterns.patterns.menu
|
|
|
1142 catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"
|
|
|
1143
|
|
|
1144 if {$fsBox(extensions)} {
|
|
|
1145 .fsBox.pattern.patterns.patterns.menu add command -label "*" -command {
|
|
|
1146 global fsBox
|
|
|
1147 set fsBox(pattern) "*"
|
|
|
1148 .fsBox.pattern.pattern delete 0 end
|
|
|
1149 .fsBox.pattern.pattern insert 0 $fsBox(pattern)
|
|
|
1150 FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern) $fsBox(all)}
|
|
|
1151 }
|
|
|
1152
|
|
|
1153 if {"$fsBoxPath" != "/"} {
|
|
|
1154 .fsBox.files.files insert end "../"
|
|
|
1155 }
|
|
|
1156 foreach fsBoxCounter $fsBoxElementList {
|
|
|
1157 if {[string match $fsBoxPattern $fsBoxCounter] ||
|
|
|
1158 [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} {
|
|
|
1159 if {"$fsBoxCounter" != "../" &&
|
|
|
1160 "$fsBoxCounter" != "./"} {
|
|
|
1161 .fsBox.files.files insert end $fsBoxCounter
|
|
|
1162 }
|
|
|
1163 }
|
|
|
1164
|
|
|
1165 if {$fsBox(extensions)} {
|
|
|
1166 catch "file rootname $fsBoxCounter" fsBoxRootName
|
|
|
1167 catch "file extension $fsBoxCounter" fsBoxExtension
|
|
|
1168 set fsBoxExtension [string trimright $fsBoxExtension "/*@"]
|
|
|
1169 if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} {
|
|
|
1170 set fsBoxInsert 1
|
|
|
1171 set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last]
|
|
|
1172 for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} {
|
|
|
1173 if {"*$fsBoxExtension" == "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure $fsBoxCounter1 -label] 4]"} {
|
|
|
1174 set fsBoxInsert 0
|
|
|
1175 }
|
|
|
1176 }
|
|
|
1177 if {$fsBoxInsert} {
|
|
|
1178 .fsBox.pattern.patterns.patterns.menu add command -label "*$fsBoxExtension" -command "
|
|
|
1179 global fsBox
|
|
|
1180 set fsBox(pattern) \"*$fsBoxExtension\"
|
|
|
1181 .fsBox.pattern.pattern delete 0 end
|
|
|
1182 .fsBox.pattern.pattern insert 0 \$fsBox(pattern)
|
|
|
1183 FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern) \$fsBox(all)"
|
|
|
1184 }
|
|
|
1185 }
|
|
|
1186 }
|
|
|
1187 }
|
|
|
1188 if {$fsBox(extensions)} {
|
|
|
1189 .fsBox.pattern.patterns.patterns.menu add separator
|
|
|
1190 }
|
|
|
1191 if {$fsBox(extensions) ||
|
|
|
1192 "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} {
|
|
|
1193 .fsBox.pattern.patterns.patterns.menu add checkbutton -label "Scan extensions" -variable "fsBox(extensions)" -command {
|
|
|
1194 global fsBox
|
|
|
1195 FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)}
|
|
|
1196 }
|
|
|
1197 }
|
|
|
1198
|
|
|
1199
|
|
|
1200 # Procedure: InputBoxInternal
|
|
|
1201 proc InputBoxInternal { inputBoxMessage inputBoxCommandOk inputBoxCommandCancel inputBoxGeometry inputBoxTitle lineNum} {
|
|
|
1202 # xf ignore me 6
|
|
|
1203 global inputBox
|
|
|
1204
|
|
|
1205 set tmpButtonOpt ""
|
|
|
1206 set tmpFrameOpt ""
|
|
|
1207 set tmpMessageOpt ""
|
|
|
1208 set tmpScaleOpt ""
|
|
|
1209 set tmpScrollOpt ""
|
|
|
1210 if {"$inputBox(activeBackground)" != ""} {
|
|
|
1211 append tmpButtonOpt "-activebackground \"$inputBox(activeBackground)\" "
|
|
|
1212 }
|
|
|
1213 if {"$inputBox(activeForeground)" != ""} {
|
|
|
1214 append tmpButtonOpt "-activeforeground \"$inputBox(activeForeground)\" "
|
|
|
1215 }
|
|
|
1216 if {"$inputBox(background)" != ""} {
|
|
|
1217 append tmpButtonOpt "-background \"$inputBox(background)\" "
|
|
|
1218 append tmpFrameOpt "-background \"$inputBox(background)\" "
|
|
|
1219 append tmpMessageOpt "-background \"$inputBox(background)\" "
|
|
|
1220 }
|
|
|
1221 if {"$inputBox(font)" != ""} {
|
|
|
1222 append tmpButtonOpt "-font \"$inputBox(font)\" "
|
|
|
1223 append tmpMessageOpt "-font \"$inputBox(font)\" "
|
|
|
1224 }
|
|
|
1225 if {"$inputBox(foreground)" != ""} {
|
|
|
1226 append tmpButtonOpt "-foreground \"$inputBox(foreground)\" "
|
|
|
1227 append tmpMessageOpt "-foreground \"$inputBox(foreground)\" "
|
|
|
1228 }
|
|
|
1229 if {"$inputBox(scrollActiveForeground)" != ""} {
|
|
|
1230 append tmpScrollOpt "-activeforeground \"$inputBox(scrollActiveForeground)\" "
|
|
|
1231 }
|
|
|
1232 if {"$inputBox(scrollBackground)" != ""} {
|
|
|
1233 append tmpScrollOpt "-background \"$inputBox(scrollBackground)\" "
|
|
|
1234 }
|
|
|
1235 if {"$inputBox(scrollForeground)" != ""} {
|
|
|
1236 append tmpScrollOpt "-foreground \"$inputBox(scrollForeground)\" "
|
|
|
1237 }
|
|
|
1238
|
|
|
1239 # start build of toplevel
|
|
|
1240 if {"[info commands XFDestroy]" != ""} {
|
|
|
1241 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1242 } {
|
|
|
1243 catch {destroy $inputBox(toplevelName)}
|
|
|
1244 }
|
|
|
1245 toplevel $inputBox(toplevelName) -borderwidth 0
|
|
|
1246 catch "$inputBox(toplevelName) config $tmpFrameOpt"
|
|
|
1247 if {[catch "wm geometry $inputBox(toplevelName) $inputBoxGeometry"]} {
|
|
|
1248 wm geometry $inputBox(toplevelName) 350x150
|
|
|
1249 }
|
|
|
1250 wm title $inputBox(toplevelName) $inputBoxTitle
|
|
|
1251 wm maxsize $inputBox(toplevelName) 1000 1000
|
|
|
1252 wm minsize $inputBox(toplevelName) 100 100
|
|
|
1253 # end build of toplevel
|
|
|
1254
|
|
|
1255 message $inputBox(toplevelName).message1 -anchor "$inputBox(anchor)" -justify "$inputBox(justify)" -relief raised -text "$inputBoxMessage"
|
|
|
1256 catch "$inputBox(toplevelName).message1 config $tmpMessageOpt"
|
|
|
1257
|
|
|
1258 set xfTmpWidth [string range $inputBoxGeometry 0 [expr [string first x $inputBoxGeometry]-1]]
|
|
|
1259 if {"$xfTmpWidth" != ""} {
|
|
|
1260 # set message size
|
|
|
1261 catch "$inputBox(toplevelName).message1 configure -width [expr $xfTmpWidth-10]"
|
|
|
1262 } {
|
|
|
1263 $inputBox(toplevelName).message1 configure -aspect 1500
|
|
|
1264 }
|
|
|
1265
|
|
|
1266 frame $inputBox(toplevelName).frame0 -borderwidth 0 -relief raised
|
|
|
1267 catch "$inputBox(toplevelName).frame0 config $tmpFrameOpt"
|
|
|
1268
|
|
|
1269 frame $inputBox(toplevelName).frame1 -borderwidth 0 -relief raised
|
|
|
1270 catch "$inputBox(toplevelName).frame1 config $tmpFrameOpt"
|
|
|
1271
|
|
|
1272 if {$lineNum == 1} {
|
|
|
1273 scrollbar $inputBox(toplevelName).frame1.hscroll -orient "horizontal" -relief raised -command "$inputBox(toplevelName).frame1.input view"
|
|
|
1274 catch "$inputBox(toplevelName).frame1.hscroll config $tmpScrollOpt"
|
|
|
1275
|
|
|
1276 entry $inputBox(toplevelName).frame1.input -relief raised -scrollcommand "$inputBox(toplevelName).frame1.hscroll set"
|
|
|
1277 catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt"
|
|
|
1278
|
|
|
1279 $inputBox(toplevelName).frame1.input insert 0 $inputBox($inputBox(toplevelName),inputOne)
|
|
|
1280
|
|
|
1281 # bindings
|
|
|
1282 bind $inputBox(toplevelName).frame1.input <Return> "
|
|
|
1283 global inputBox
|
|
|
1284 set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\]
|
|
|
1285 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
1286 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1287 } {
|
|
|
1288 catch {destroy $inputBox(toplevelName)}
|
|
|
1289 }
|
|
|
1290 $inputBoxCommandOk"
|
|
|
1291
|
|
|
1292 # packing
|
|
|
1293 pack append $inputBox(toplevelName).frame1 $inputBox(toplevelName).frame1.hscroll {bottom fill} $inputBox(toplevelName).frame1.input {top fill expand}
|
|
|
1294 } {
|
|
|
1295 text $inputBox(toplevelName).frame1.input -relief raised -wrap none -borderwidth 2 -yscrollcommand "$inputBox(toplevelName).frame1.vscroll set"
|
|
|
1296 catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt"
|
|
|
1297
|
|
|
1298 scrollbar $inputBox(toplevelName).frame1.vscroll -relief raised -command "$inputBox(toplevelName).frame1.input yview"
|
|
|
1299 catch "$inputBox(toplevelName).frame1.vscroll config $tmpScrollOpt"
|
|
|
1300
|
|
|
1301 $inputBox(toplevelName).frame1.input insert 1.0 $inputBox($inputBox(toplevelName),inputMulti)
|
|
|
1302
|
|
|
1303 # bindings
|
|
|
1304 bind $inputBox(toplevelName).frame1.input <Control-Return> "
|
|
|
1305 global inputBox
|
|
|
1306 set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
|
|
|
1307 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
1308 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1309 } {
|
|
|
1310 catch {destroy $inputBox(toplevelName)}
|
|
|
1311 }
|
|
|
1312 $inputBoxCommandOk"
|
|
|
1313 bind $inputBox(toplevelName).frame1.input <Meta-Return> "
|
|
|
1314 global inputBox
|
|
|
1315 set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
|
|
|
1316 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
1317 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1318 } {
|
|
|
1319 catch {destroy $inputBox(toplevelName)}
|
|
|
1320 }
|
|
|
1321 $inputBoxCommandOk"
|
|
|
1322
|
|
|
1323 # packing
|
|
|
1324 pack append $inputBox(toplevelName).frame1 $inputBox(toplevelName).frame1.vscroll "$inputBox(scrollSide) filly" $inputBox(toplevelName).frame1.input {left fill expand}
|
|
|
1325 }
|
|
|
1326
|
|
|
1327 button $inputBox(toplevelName).frame0.button0 -text "OK" -command "
|
|
|
1328 global inputBox
|
|
|
1329 if {$lineNum == 1} {
|
|
|
1330 set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\]
|
|
|
1331 } {
|
|
|
1332 set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
|
|
|
1333 }
|
|
|
1334 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
1335 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1336 } {
|
|
|
1337 catch {destroy $inputBox(toplevelName)}
|
|
|
1338 }
|
|
|
1339 $inputBoxCommandOk"
|
|
|
1340 catch "$inputBox(toplevelName).frame0.button0 config $tmpButtonOpt"
|
|
|
1341
|
|
|
1342 button $inputBox(toplevelName).frame0.button1 -text "Cancel" -command "
|
|
|
1343 global inputBox
|
|
|
1344 if {$lineNum == 1} {
|
|
|
1345 set inputBox($inputBox(toplevelName),inputOne) \"\"
|
|
|
1346 } {
|
|
|
1347 set inputBox($inputBox(toplevelName),inputMulti) \"\"
|
|
|
1348 }
|
|
|
1349 if {\"\[info commands XFDestroy\]\" != \"\"} {
|
|
|
1350 catch {XFDestroy $inputBox(toplevelName)}
|
|
|
1351 } {
|
|
|
1352 catch {destroy $inputBox(toplevelName)}
|
|
|
1353 }
|
|
|
1354 $inputBoxCommandCancel"
|
|
|
1355 catch "$inputBox(toplevelName).frame0.button1 config $tmpButtonOpt"
|
|
|
1356
|
|
|
1357 pack append $inputBox(toplevelName).frame0 $inputBox(toplevelName).frame0.button0 {left fill expand} $inputBox(toplevelName).frame0.button1 {left fill expand}
|
|
|
1358
|
|
|
1359 pack append $inputBox(toplevelName) $inputBox(toplevelName).frame0 {bottom fill} $inputBox(toplevelName).frame1 {bottom fill expand} $inputBox(toplevelName).message1 {top fill}
|
|
|
1360 }
|
|
|
1361
|
|
|
1362
|
|
|
1363 # Procedure: InputBoxMulti
|
|
|
1364 proc InputBoxMulti { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} {
|
|
|
1365 # xf ignore me 5
|
|
|
1366 ##########
|
|
|
1367 # Procedure: InputBoxMulti
|
|
|
1368 # Description: show input box with one text line
|
|
|
1369 # Arguments: {inputBoxMessage} - message to display
|
|
|
1370 # {inputBoxCommandOk} - the command to call after ok
|
|
|
1371 # {inputBoxCommandCancel} - the command to call after cancel
|
|
|
1372 # {inputBoxGeometry} - the geometry for the window
|
|
|
1373 # {inputBoxTitle} - the title for the window
|
|
|
1374 # Returns: The entered text
|
|
|
1375 # Sideeffects: none
|
|
|
1376 # Notes: there exist also a function called:
|
|
|
1377 # InputBoxOne - to enter one line text
|
|
|
1378 ##########
|
|
|
1379 #
|
|
|
1380 # global inputBox(activeBackground) - active background color
|
|
|
1381 # global inputBox(activeForeground) - active foreground color
|
|
|
1382 # global inputBox(anchor) - anchor for message box
|
|
|
1383 # global inputBox(background) - background color
|
|
|
1384 # global inputBox(erase) - erase previous text
|
|
|
1385 # global inputBox(font) - message font
|
|
|
1386 # global inputBox(foreground) - foreground color
|
|
|
1387 # global inputBox(justify) - justify for message box
|
|
|
1388 # global inputBox(scrollActiveForeground) - scrollbar active background color
|
|
|
1389 # global inputBox(scrollBackground) - scrollbar background color
|
|
|
1390 # global inputBox(scrollForeground) - scrollbar foreground color
|
|
|
1391 # global inputBox(scrollSide) - side where scrollbar is located
|
|
|
1392 # global inputBox(toplevelName) - the toplevel name
|
|
|
1393 # global inputBox(toplevelName,inputMulti) - the text in the text widget
|
|
|
1394
|
|
|
1395 global inputBox
|
|
|
1396
|
|
|
1397 if {"$inputBoxGeometry" == ""} {
|
|
|
1398 set inputBoxGeometry 350x150
|
|
|
1399 }
|
|
|
1400 if {$inputBox(erase)} {
|
|
|
1401 set inputBox($inputBox(toplevelName),inputMulti) ""
|
|
|
1402 } {
|
|
|
1403 if {![info exists inputBox($inputBox(toplevelName),inputMulti)]} {
|
|
|
1404 set inputBox($inputBox(toplevelName),inputMulti) ""
|
|
|
1405 }
|
|
|
1406 }
|
|
|
1407 InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 2
|
|
|
1408
|
|
|
1409 # wait for the box to be destroyed
|
|
|
1410 update idletask
|
|
|
1411 grab $inputBox(toplevelName)
|
|
|
1412 tkwait window $inputBox(toplevelName)
|
|
|
1413
|
|
|
1414 return $inputBox($inputBox(toplevelName),inputMulti)
|
|
|
1415 }
|
|
|
1416
|
|
|
1417
|
|
|
1418 # Procedure: InputBoxOne
|
|
|
1419 proc InputBoxOne { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} {
|
|
|
1420 # xf ignore me 5
|
|
|
1421 ##########
|
|
|
1422 # Procedure: InputBoxOne
|
|
|
1423 # Description: show input box with one text line
|
|
|
1424 # Arguments: {inputBoxMessage} - message to display
|
|
|
1425 # {inputBoxCommandOk} - the command to call after ok
|
|
|
1426 # {inputBoxCommandCancel} - the command to call after cancel
|
|
|
1427 # {inputBoxGeometry} - the geometry for the window
|
|
|
1428 # {inputBoxTitle} - the title for the window
|
|
|
1429 # Returns: The entered text
|
|
|
1430 # Sideeffects: none
|
|
|
1431 # Notes: there exist also a function called:
|
|
|
1432 # InputBoxMulti - to enter multiline text
|
|
|
1433 ##########
|
|
|
1434 #
|
|
|
1435 # global inputBox(activeBackground) - active background color
|
|
|
1436 # global inputBox(activeForeground) - active foreground color
|
|
|
1437 # global inputBox(anchor) - anchor for message box
|
|
|
1438 # global inputBox(background) - background color
|
|
|
1439 # global inputBox(erase) - erase previous text
|
|
|
1440 # global inputBox(font) - message font
|
|
|
1441 # global inputBox(foreground) - foreground color
|
|
|
1442 # global inputBox(justify) - justify for message box
|
|
|
1443 # global inputBox(scrollActiveForeground) - scrollbar active background color
|
|
|
1444 # global inputBox(scrollBackground) - scrollbar background color
|
|
|
1445 # global inputBox(scrollForeground) - scrollbar foreground color
|
|
|
1446 # global inputBox(scrollSide) - side where scrollbar is located
|
|
|
1447 # global inputBox(toplevelName) - the toplevel name
|
|
|
1448 # global inputBox(toplevelName,inputOne) - the text in the entry widget
|
|
|
1449
|
|
|
1450 global inputBox
|
|
|
1451
|
|
|
1452 if {$inputBox(erase)} {
|
|
|
1453 set inputBox($inputBox(toplevelName),inputOne) ""
|
|
|
1454 } {
|
|
|
1455 if {![info exists inputBox($inputBox(toplevelName),inputOne)]} {
|
|
|
1456 set inputBox($inputBox(toplevelName),inputOne) ""
|
|
|
1457 }
|
|
|
1458 }
|
|
|
1459 InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 1
|
|
|
1460
|
|
|
1461 # wait for the box to be destroyed
|
|
|
1462 update idletask
|
|
|
1463 grab $inputBox(toplevelName)
|
|
|
1464 tkwait window $inputBox(toplevelName)
|
|
|
1465
|
|
|
1466 return $inputBox($inputBox(toplevelName),inputOne)
|
|
|
1467 }
|
|
|
1468
|
|
|
1469
|
|
|
1470 # Procedure: IsADir
|
|
|
1471 proc IsADir { pathName} {
|
|
|
1472 # xf ignore me 5
|
|
|
1473 ##########
|
|
|
1474 # Procedure: IsADir
|
|
|
1475 # Description: check if name is a directory (including symbolic links)
|
|
|
1476 # Arguments: pathName - the path to check
|
|
|
1477 # Returns: 1 if its a directory, otherwise 0
|
|
|
1478 # Sideeffects: none
|
|
|
1479 ##########
|
|
|
1480
|
|
|
1481 if {[file isdirectory $pathName]} {
|
|
|
1482 return 1
|
|
|
1483 } {
|
|
|
1484 catch "file type $pathName" fileType
|
|
|
1485 if {"$fileType" == "link"} {
|
|
|
1486 if {[catch "file readlink $pathName" linkName]} {
|
|
|
1487 return 0
|
|
|
1488 }
|
|
|
1489 catch "file type $linkName" fileType
|
|
|
1490 while {"$fileType" == "link"} {
|
|
|
1491 if {[catch "file readlink $linkName" linkName]} {
|
|
|
1492 return 0
|
|
|
1493 }
|
|
|
1494 catch "file type $linkName" fileType
|
|
|
1495 }
|
|
|
1496 return [file isdirectory $linkName]
|
|
|
1497 }
|
|
|
1498 }
|
|
|
1499 return 0
|
|
|
1500 }
|
|
|
1501
|
|
|
1502
|
|
|
1503 # Procedure: IsAFile
|
|
|
1504 proc IsAFile { fileName} {
|
|
|
1505 # xf ignore me 5
|
|
|
1506 ##########
|
|
|
1507 # Procedure: IsAFile
|
|
|
1508 # Description: check if filename is a file (including symbolic links)
|
|
|
1509 # Arguments: fileName - the filename to check
|
|
|
1510 # Returns: 1 if its a file, otherwise 0
|
|
|
1511 # Sideeffects: none
|
|
|
1512 ##########
|
|
|
1513
|
|
|
1514 if {[file isfile $fileName]} {
|
|
|
1515 return 1
|
|
|
1516 } {
|
|
|
1517 catch "file type $fileName" fileType
|
|
|
1518 if {"$fileType" == "link"} {
|
|
|
1519 if {[catch "file readlink $fileName" linkName]} {
|
|
|
1520 return 0
|
|
|
1521 }
|
|
|
1522 catch "file type $linkName" fileType
|
|
|
1523 while {"$fileType" == "link"} {
|
|
|
1524 if {[catch "file readlink $linkName" linkName]} {
|
|
|
1525 return 0
|
|
|
1526 }
|
|
|
1527 catch "file type $linkName" fileType
|
|
|
1528 }
|
|
|
1529 return [file isfile $linkName]
|
|
|
1530 }
|
|
|
1531 }
|
|
|
1532 return 0
|
|
|
1533 }
|
|
|
1534
|
|
|
1535
|
|
|
1536 # Procedure: IsASymlink
|
|
|
1537 proc IsASymlink { fileName} {
|
|
|
1538 # xf ignore me 5
|
|
|
1539 ##########
|
|
|
1540 # Procedure: IsASymlink
|
|
|
1541 # Description: check if filename is a symbolic link
|
|
|
1542 # Arguments: fileName - the path/filename to check
|
|
|
1543 # Returns: none
|
|
|
1544 # Sideeffects: none
|
|
|
1545 ##########
|
|
|
1546
|
|
|
1547 catch "file type $fileName" fileType
|
|
|
1548 if {"$fileType" == "link"} {
|
|
|
1549 return 1
|
|
|
1550 }
|
|
|
1551 return 0
|
|
|
1552 }
|
|
|
1553
|
|
|
1554
|
|
|
1555 # Procedure: PrologCommand
|
|
|
1556 proc PrologCommand {} {
|
|
|
1557 prolog {prolog_call [InputBoxOne "Prolog Command:"]} lite
|
|
|
1558 }
|
|
|
1559
|
|
|
1560
|
|
|
1561 # Procedure: TokioCommand
|
|
|
1562 proc TokioCommand {} {
|
|
|
1563 prolog {tokio_call [InputBoxOne "Tokio Command:"]} lite
|
|
|
1564 }
|
|
|
1565
|
|
|
1566
|
|
|
1567 # Procedure: canvaswh
|
|
|
1568 proc canvaswh { c scale} {
|
|
|
1569 global scalex scaley
|
|
|
1570 if {! $scalex && ! $scaley } {
|
|
|
1571 regexp {([0-9]+)x([0-9]+)} [wm geometry .] dm w h
|
|
|
1572 set h [$c canvasy [expr $h/2]]
|
|
|
1573 set w [$c canvasx [expr $w/2]]
|
|
|
1574 } else {
|
|
|
1575 set h $scaley
|
|
|
1576 set w $scalex
|
|
|
1577 }
|
|
|
1578 $c scale all $w $h $scale $scale
|
|
|
1579 }
|
|
|
1580
|
|
|
1581
|
|
|
1582 # Procedure: crosshair
|
|
|
1583 proc crosshair { c x y} {
|
|
|
1584 global scalex scaley
|
|
|
1585 if {[$c find withtag cursol] != {}} {
|
|
|
1586 $c delete cursol
|
|
|
1587 }
|
|
|
1588 set cs 5
|
|
|
1589 set x [$c canvasx $x]
|
|
|
1590 set y [$c canvasy $y]
|
|
|
1591 $c create line $x [expr $y - $cs] $x [expr $y + $cs] -tags cursol
|
|
|
1592 $c create line [expr $x - $cs] $y [expr $x + $cs] $y -tags cursol
|
|
|
1593 set scalex $x
|
|
|
1594 set scaley $y
|
|
|
1595 }
|
|
|
1596
|
|
|
1597
|
|
|
1598 # Procedure: event
|
|
|
1599 proc event { args now} {
|
|
|
1600 prolog "tokio_event $args $now" tokio
|
|
|
1601 }
|
|
|
1602
|
|
|
1603
|
|
|
1604 # Procedure: filehandling
|
|
|
1605 proc filehandling { t mode file} {
|
|
|
1606 if {[string compare $mode "load"] == 0} {
|
|
|
1607 if [file isfile $file] {
|
|
|
1608 $t delete 0.0 end
|
|
|
1609 set F [open $file r]
|
|
|
1610 while {[gets $F string] != -1} {
|
|
|
1611 $t insert end "$string\n"
|
|
|
1612 }
|
|
|
1613 close $F
|
|
|
1614 }
|
|
|
1615 } else {
|
|
|
1616 set line [$t get 0.0 end]
|
|
|
1617 # if [file writable $dir] {
|
|
|
1618 if [expr [llength $line] > 0] {
|
|
|
1619 set F [open $file w]
|
|
|
1620 puts $F $line
|
|
|
1621 close $F
|
|
|
1622 }
|
|
|
1623 # }
|
|
|
1624 }
|
|
|
1625 }
|
|
|
1626
|
|
|
1627
|
|
|
1628 # Procedure: lite
|
|
|
1629 proc lite { a b} {
|
|
|
1630 prolog "event $a $b" lite
|
|
|
1631 }
|
|
|
1632
|
|
|
1633
|
|
|
1634 # Procedure: text_clear
|
|
|
1635 proc text_clear { t} {
|
|
|
1636 $t delete 0.0 end
|
|
|
1637 }
|
|
|
1638
|
|
|
1639
|
|
|
1640 # Internal procedures
|
|
|
1641
|
|
|
1642
|
|
|
1643 # Procedure: Alias
|
|
|
1644 if {"[info procs Alias]" == ""} {
|
|
|
1645 proc Alias { args} {
|
|
|
1646 # xf ignore me 7
|
|
|
1647 ##########
|
|
|
1648 # Procedure: Alias
|
|
|
1649 # Description: establish an alias for a procedure
|
|
|
1650 # Arguments: args - no argument means that a list of all aliases
|
|
|
1651 # is returned. Otherwise the first parameter is
|
|
|
1652 # the alias name, and the second parameter is
|
|
|
1653 # the procedure that is aliased.
|
|
|
1654 # Returns: nothing, the command that is bound to the alias or a
|
|
|
1655 # list of all aliases - command pairs.
|
|
|
1656 # Sideeffects: internalAliasList is updated, and the alias
|
|
|
1657 # proc is inserted
|
|
|
1658 ##########
|
|
|
1659 global internalAliasList
|
|
|
1660
|
|
|
1661 if {[llength $args] == 0} {
|
|
|
1662 return $internalAliasList
|
|
|
1663 } {
|
|
|
1664 if {[llength $args] == 1} {
|
|
|
1665 set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
|
|
|
1666 if {$xfTmpIndex != -1} {
|
|
|
1667 return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
|
|
|
1668 }
|
|
|
1669 } {
|
|
|
1670 if {[llength $args] == 2} {
|
|
|
1671 eval "proc [lindex $args 0] {args} {#xf ignore me 4
|
|
|
1672 return \[eval \"[lindex $args 1] \$args\"\]}"
|
|
|
1673 set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
|
|
|
1674 if {$xfTmpIndex != -1} {
|
|
|
1675 set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
|
|
|
1676 } {
|
|
|
1677 lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
|
|
|
1678 }
|
|
|
1679 } {
|
|
|
1680 error "Alias: wrong number or args: $args"
|
|
|
1681 }
|
|
|
1682 }
|
|
|
1683 }
|
|
|
1684 }
|
|
|
1685 }
|
|
|
1686
|
|
|
1687
|
|
|
1688 # Procedure: GetSelection
|
|
|
1689 if {"[info procs GetSelection]" == ""} {
|
|
|
1690 proc GetSelection {} {
|
|
|
1691 # xf ignore me 7
|
|
|
1692 ##########
|
|
|
1693 # Procedure: GetSelection
|
|
|
1694 # Description: get current selection
|
|
|
1695 # Arguments: none
|
|
|
1696 # Returns: none
|
|
|
1697 # Sideeffects: none
|
|
|
1698 ##########
|
|
|
1699
|
|
|
1700 # the save way
|
|
|
1701 set xfSelection ""
|
|
|
1702 catch "selection get" xfSelection
|
|
|
1703 if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
|
|
|
1704 return ""
|
|
|
1705 } {
|
|
|
1706 return $xfSelection
|
|
|
1707 }
|
|
|
1708 }
|
|
|
1709 }
|
|
|
1710
|
|
|
1711
|
|
|
1712 # Procedure: MenuPopupAdd
|
|
|
1713 if {"[info procs MenuPopupAdd]" == ""} {
|
|
|
1714 proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} {
|
|
|
1715 # xf ignore me 7
|
|
|
1716 # the popup menu handling is from (I already gave up with popup handling :-):
|
|
|
1717 #
|
|
|
1718 # Copyright 1991,1992 by James Noble.
|
|
|
1719 # Everyone is granted permission to copy, modify and redistribute.
|
|
|
1720 # This notice must be preserved on all copies or derivates.
|
|
|
1721 #
|
|
|
1722 ##########
|
|
|
1723 # Procedure: MenuPopupAdd
|
|
|
1724 # Description: attach a popup menu to widget
|
|
|
1725 # Arguments: xfW - the widget
|
|
|
1726 # xfButton - the button we use
|
|
|
1727 # xfMenu - the menu to attach
|
|
|
1728 # {xfModifier} - a optional modifier
|
|
|
1729 # {xfCanvasTag} - a canvas tagOrId
|
|
|
1730 # Returns: none
|
|
|
1731 # Sideeffects: none
|
|
|
1732 ##########
|
|
|
1733 global tk_popupPriv
|
|
|
1734
|
|
|
1735 set tk_popupPriv($xfMenu,focus) ""
|
|
|
1736 set tk_popupPriv($xfMenu,grab) ""
|
|
|
1737 if {"$xfModifier" != ""} {
|
|
|
1738 set press "$xfModifier-"
|
|
|
1739 set motion "$xfModifier-"
|
|
|
1740 set release "Any-"
|
|
|
1741 } {
|
|
|
1742 set press ""
|
|
|
1743 set motion ""
|
|
|
1744 set release ""
|
|
|
1745 }
|
|
|
1746
|
|
|
1747 bind $xfMenu "<${motion}B${xfButton}-Motion>" "MenuPopupMotion $xfMenu %W %X %Y"
|
|
|
1748 bind $xfMenu "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
1749 if {"$xfCanvasTag" == ""} {
|
|
|
1750 bind $xfW "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y"
|
|
|
1751 bind $xfW "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
1752 } {
|
|
|
1753 $xfW bind $xfCanvasTag "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y"
|
|
|
1754 $xfW bind $xfCanvasTag "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W"
|
|
|
1755 }
|
|
|
1756 }
|
|
|
1757 }
|
|
|
1758
|
|
|
1759
|
|
|
1760 # Procedure: MenuPopupMotion
|
|
|
1761 if {"[info procs MenuPopupMotion]" == ""} {
|
|
|
1762 proc MenuPopupMotion { xfMenu xfW xfX xfY} {
|
|
|
1763 # xf ignore me 7
|
|
|
1764 ##########
|
|
|
1765 # Procedure: MenuPopupMotion
|
|
|
1766 # Description: handle the popup menu motion
|
|
|
1767 # Arguments: xfMenu - the topmost menu
|
|
|
1768 # xfW - the menu
|
|
|
1769 # xfX - the root x coordinate
|
|
|
1770 # xfY - the root x coordinate
|
|
|
1771 # Returns: none
|
|
|
1772 # Sideeffects: none
|
|
|
1773 ##########
|
|
|
1774 global tk_popupPriv
|
|
|
1775
|
|
|
1776 if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
|
|
|
1777 "[winfo class $xfW]" == "Menu" &&
|
|
|
1778 [info exists tk_popupPriv($xfMenu,focus)] &&
|
|
|
1779 "$tk_popupPriv($xfMenu,focus)" != "" &&
|
|
|
1780 [info exists tk_popupPriv($xfMenu,grab)] &&
|
|
|
1781 "$tk_popupPriv($xfMenu,grab)" != ""} {
|
|
|
1782 set xfPopMinX [winfo rootx $xfW]
|
|
|
1783 set xfPopMaxX [expr $xfPopMinX+[winfo width $xfW]]
|
|
|
1784 if {$xfX >= $xfPopMinX && $xfX <= $xfPopMaxX} {
|
|
|
1785 $xfW activate @[expr $xfY-[winfo rooty $xfW]]
|
|
|
1786 if {![catch "$xfW entryconfig @[expr $xfY-[winfo rooty $xfW]] -menu" result]} {
|
|
|
1787 if {"[lindex $result 4]" != ""} {
|
|
|
1788 foreach binding [bind $xfMenu] {
|
|
|
1789 bind [lindex $result 4] $binding [bind $xfMenu $binding]
|
|
|
1790 }
|
|
|
1791 }
|
|
|
1792 }
|
|
|
1793 } {
|
|
|
1794 $xfW activate none
|
|
|
1795 }
|
|
|
1796 }
|
|
|
1797 }
|
|
|
1798 }
|
|
|
1799
|
|
|
1800
|
|
|
1801 # Procedure: MenuPopupPost
|
|
|
1802 if {"[info procs MenuPopupPost]" == ""} {
|
|
|
1803 proc MenuPopupPost { xfMenu xfX xfY} {
|
|
|
1804 # xf ignore me 7
|
|
|
1805 ##########
|
|
|
1806 # Procedure: MenuPopupPost
|
|
|
1807 # Description: post the popup menu
|
|
|
1808 # Arguments: xfMenu - the menu
|
|
|
1809 # xfX - the root x coordinate
|
|
|
1810 # xfY - the root x coordinate
|
|
|
1811 # Returns: none
|
|
|
1812 # Sideeffects: none
|
|
|
1813 ##########
|
|
|
1814 global tk_popupPriv
|
|
|
1815
|
|
|
1816 if {"[info commands $xfMenu]" != ""} {
|
|
|
1817 if {![info exists tk_popupPriv($xfMenu,focus)]} {
|
|
|
1818 set tk_popupPriv($xfMenu,focus) [focus]
|
|
|
1819 } {
|
|
|
1820 if {"$tk_popupPriv($xfMenu,focus)" == ""} {
|
|
|
1821 set tk_popupPriv($xfMenu,focus) [focus]
|
|
|
1822 }
|
|
|
1823 }
|
|
|
1824 set tk_popupPriv($xfMenu,grab) $xfMenu
|
|
|
1825
|
|
|
1826 catch "$xfMenu activate none"
|
|
|
1827 catch "$xfMenu post $xfX $xfY"
|
|
|
1828 catch "focus $xfMenu"
|
|
|
1829 catch "grab -global $xfMenu"
|
|
|
1830 }
|
|
|
1831 }
|
|
|
1832 }
|
|
|
1833
|
|
|
1834
|
|
|
1835 # Procedure: MenuPopupRelease
|
|
|
1836 if {"[info procs MenuPopupRelease]" == ""} {
|
|
|
1837 proc MenuPopupRelease { xfMenu xfW} {
|
|
|
1838 # xf ignore me 7
|
|
|
1839 ##########
|
|
|
1840 # Procedure: MenuPopupRelease
|
|
|
1841 # Description: remove the popup menu
|
|
|
1842 # Arguments: xfMenu - the topmost menu widget
|
|
|
1843 # xfW - the menu widget
|
|
|
1844 # Returns: none
|
|
|
1845 # Sideeffects: none
|
|
|
1846 ##########
|
|
|
1847 global tk_popupPriv
|
|
|
1848 global tkVersion
|
|
|
1849
|
|
|
1850 if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
|
|
|
1851 "[winfo class $xfW]" == "Menu" &&
|
|
|
1852 [info exists tk_popupPriv($xfMenu,focus)] &&
|
|
|
1853 "$tk_popupPriv($xfMenu,focus)" != "" &&
|
|
|
1854 [info exists tk_popupPriv($xfMenu,grab)] &&
|
|
|
1855 "$tk_popupPriv($xfMenu,grab)" != ""} {
|
|
|
1856 if {$tkVersion >= 3.0} {
|
|
|
1857 catch "grab release $tk_popupPriv($xfMenu,grab)"
|
|
|
1858 } {
|
|
|
1859 catch "grab none"
|
|
|
1860 }
|
|
|
1861 catch "focus $tk_popupPriv($xfMenu,focus)"
|
|
|
1862 set tk_popupPriv($xfMenu,focus) ""
|
|
|
1863 set tk_popupPriv($xfMenu,grab) ""
|
|
|
1864 if {"[$xfW index active]" != "none"} {
|
|
|
1865 $xfW invoke active; catch "$xfMenu unpost"
|
|
|
1866 }
|
|
|
1867 }
|
|
|
1868 catch "$xfMenu unpost"
|
|
|
1869 }
|
|
|
1870 }
|
|
|
1871
|
|
|
1872
|
|
|
1873 # Procedure: NoFunction
|
|
|
1874 if {"[info procs NoFunction]" == ""} {
|
|
|
1875 proc NoFunction { args} {
|
|
|
1876 # xf ignore me 7
|
|
|
1877 ##########
|
|
|
1878 # Procedure: NoFunction
|
|
|
1879 # Description: do nothing (especially with scales and scrollbars)
|
|
|
1880 # Arguments: args - a number of ignored parameters
|
|
|
1881 # Returns: none
|
|
|
1882 # Sideeffects: none
|
|
|
1883 ##########
|
|
|
1884 }
|
|
|
1885 }
|
|
|
1886
|
|
|
1887
|
|
|
1888 # Procedure: SN
|
|
|
1889 if {"[info procs SN]" == ""} {
|
|
|
1890 proc SN { {xfName ""}} {
|
|
|
1891 # xf ignore me 7
|
|
|
1892 ##########
|
|
|
1893 # Procedure: SN
|
|
|
1894 # Description: map a symbolic name to the widget path
|
|
|
1895 # Arguments: xfName
|
|
|
1896 # Returns: the symbolic name
|
|
|
1897 # Sideeffects: none
|
|
|
1898 ##########
|
|
|
1899
|
|
|
1900 SymbolicName $xfName
|
|
|
1901 }
|
|
|
1902 }
|
|
|
1903
|
|
|
1904
|
|
|
1905 # Procedure: SymbolicName
|
|
|
1906 if {"[info procs SymbolicName]" == ""} {
|
|
|
1907 proc SymbolicName { {xfName ""}} {
|
|
|
1908 # xf ignore me 7
|
|
|
1909 ##########
|
|
|
1910 # Procedure: SymbolicName
|
|
|
1911 # Description: map a symbolic name to the widget path
|
|
|
1912 # Arguments: xfName
|
|
|
1913 # Returns: the symbolic name
|
|
|
1914 # Sideeffects: none
|
|
|
1915 ##########
|
|
|
1916
|
|
|
1917 global symbolicName
|
|
|
1918
|
|
|
1919 if {"$xfName" != ""} {
|
|
|
1920 set xfArrayName ""
|
|
|
1921 append xfArrayName symbolicName ( $xfName )
|
|
|
1922 if {![catch "set \"$xfArrayName\"" xfValue]} {
|
|
|
1923 return $xfValue
|
|
|
1924 } {
|
|
|
1925 if {"[info commands XFProcError]" != ""} {
|
|
|
1926 XFProcError "Unknown symbolic name:\n$xfName"
|
|
|
1927 } {
|
|
|
1928 puts stderr "XF error: unknown symbolic name:\n$xfName"
|
|
|
1929 }
|
|
|
1930 }
|
|
|
1931 }
|
|
|
1932 return ""
|
|
|
1933 }
|
|
|
1934 }
|
|
|
1935
|
|
|
1936
|
|
|
1937 # Procedure: Unalias
|
|
|
1938 if {"[info procs Unalias]" == ""} {
|
|
|
1939 proc Unalias { aliasName} {
|
|
|
1940 # xf ignore me 7
|
|
|
1941 ##########
|
|
|
1942 # Procedure: Unalias
|
|
|
1943 # Description: remove an alias for a procedure
|
|
|
1944 # Arguments: aliasName - the alias name to remove
|
|
|
1945 # Returns: none
|
|
|
1946 # Sideeffects: internalAliasList is updated, and the alias
|
|
|
1947 # proc is removed
|
|
|
1948 ##########
|
|
|
1949 global internalAliasList
|
|
|
1950
|
|
|
1951 set xfIndex [lsearch $internalAliasList "$aliasName *"]
|
|
|
1952 if {$xfIndex != -1} {
|
|
|
1953 rename $aliasName ""
|
|
|
1954 set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
|
|
|
1955 }
|
|
|
1956 }
|
|
|
1957 }
|
|
|
1958
|
|
|
1959
|
|
|
1960
|
|
|
1961 # application parsing procedure
|
|
|
1962 proc XFLocalParseAppDefs {xfAppDefFile} {
|
|
|
1963 global xfAppDefaults
|
|
|
1964
|
|
|
1965 # basically from: Michael Moore
|
|
|
1966 if {[file exists $xfAppDefFile] &&
|
|
|
1967 [file readable $xfAppDefFile] &&
|
|
|
1968 "[file type $xfAppDefFile]" == "link"} {
|
|
|
1969 catch "file type $xfAppDefFile" xfType
|
|
|
1970 while {"$xfType" == "link"} {
|
|
|
1971 if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} {
|
|
|
1972 return
|
|
|
1973 }
|
|
|
1974 catch "file type $xfAppDefFile" xfType
|
|
|
1975 }
|
|
|
1976 }
|
|
|
1977 if {!("$xfAppDefFile" != "" &&
|
|
|
1978 [file exists $xfAppDefFile] &&
|
|
|
1979 [file readable $xfAppDefFile] &&
|
|
|
1980 "[file type $xfAppDefFile]" == "file")} {
|
|
|
1981 return
|
|
|
1982 }
|
|
|
1983 if {![catch "open $xfAppDefFile r" xfResult]} {
|
|
|
1984 set xfAppFileContents [read $xfResult]
|
|
|
1985 close $xfResult
|
|
|
1986 foreach line [split $xfAppFileContents "\n"] {
|
|
|
1987 # backup indicates how far to backup. It applies to the
|
|
|
1988 # situation where a resource name ends in . and when it
|
|
|
1989 # ends in *. In the second case you want to keep the *
|
|
|
1990 # in the widget name for pattern matching, but you want
|
|
|
1991 # to get rid of the . if it is the end of the name.
|
|
|
1992 set backup -2
|
|
|
1993 set line [string trim $line]
|
|
|
1994 if {[string index $line 0] == "#" || "$line" == ""} {
|
|
|
1995 # skip comments and empty lines
|
|
|
1996 continue
|
|
|
1997 }
|
|
|
1998 set list [split $line ":"]
|
|
|
1999 set resource [string trim [lindex $list 0]]
|
|
|
2000 set i [string last "." $resource]
|
|
|
2001 set j [string last "*" $resource]
|
|
|
2002 if {$j > $i} {
|
|
|
2003 set i $j
|
|
|
2004 set backup -1
|
|
|
2005 }
|
|
|
2006 incr i
|
|
|
2007 set name [string range $resource $i end]
|
|
|
2008 incr i $backup
|
|
|
2009 set widname [string range $resource 0 $i]
|
|
|
2010 set value [string trim [lindex $list 1]]
|
|
|
2011 if {"$widname" != "" && "$widname" != "*"} {
|
|
|
2012 # insert the widget and resourcename to the application
|
|
|
2013 # defaults list.
|
|
|
2014 if {![info exists xfAppDefaults]} {
|
|
|
2015 set xfAppDefaults ""
|
|
|
2016 }
|
|
|
2017 lappend xfAppDefaults [list $widname [string tolower $name] $value]
|
|
|
2018 }
|
|
|
2019 }
|
|
|
2020 }
|
|
|
2021 }
|
|
|
2022
|
|
|
2023 # application loading procedure
|
|
|
2024 proc XFLocalLoadAppDefs {{xfClasses ""} {xfPriority "startupFile"} {xfAppDefFile ""}} {
|
|
|
2025 global env
|
|
|
2026
|
|
|
2027 if {"$xfAppDefFile" == ""} {
|
|
|
2028 set xfFileList ""
|
|
|
2029 if {[info exists env(XUSERFILESEARCHPATH)]} {
|
|
|
2030 append xfFileList [split $env(XUSERFILESEARCHPATH) :]
|
|
|
2031 }
|
|
|
2032 if {[info exists env(XAPPLRESDIR)]} {
|
|
|
2033 append xfFileList [split $env(XAPPLRESDIR) :]
|
|
|
2034 }
|
|
|
2035 if {[info exists env(XFILESEARCHPATH)]} {
|
|
|
2036 append xfFileList [split $env(XFILESEARCHPATH) :]
|
|
|
2037 }
|
|
|
2038 append xfFileList " /usr/lib/X11/app-defaults"
|
|
|
2039 append xfFileList " /usr/X11/lib/X11/app-defaults"
|
|
|
2040
|
|
|
2041 foreach xfCounter1 $xfClasses {
|
|
|
2042 foreach xfCounter2 $xfFileList {
|
|
|
2043 set xfPathName $xfCounter2
|
|
|
2044 if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} {
|
|
|
2045 set xfPathName $xfResult
|
|
|
2046 }
|
|
|
2047 if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} {
|
|
|
2048 set xfPathName $xfResult
|
|
|
2049 }
|
|
|
2050 if {[regsub -all "%S" "$xfPathName" "" xfResult]} {
|
|
|
2051 set xfPathName $xfResult
|
|
|
2052 }
|
|
|
2053 if {[regsub -all "%C" "$xfPathName" "" xfResult]} {
|
|
|
2054 set xfPathName $xfResult
|
|
|
2055 }
|
|
|
2056 if {[file exists $xfPathName] &&
|
|
|
2057 [file readable $xfPathName] &&
|
|
|
2058 ("[file type $xfPathName]" == "file" ||
|
|
|
2059 "[file type $xfPathName]" == "link")} {
|
|
|
2060 catch "option readfile $xfPathName $xfPriority"
|
|
|
2061 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
2062 XFParseAppDefs $xfPathName
|
|
|
2063 } {
|
|
|
2064 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
2065 XFLocalParseAppDefs $xfPathName
|
|
|
2066 }
|
|
|
2067 }
|
|
|
2068 } {
|
|
|
2069 if {[file exists $xfCounter2/$xfCounter1] &&
|
|
|
2070 [file readable $xfCounter2/$xfCounter1] &&
|
|
|
2071 ("[file type $xfCounter2/$xfCounter1]" == "file" ||
|
|
|
2072 "[file type $xfCounter2/$xfCounter1]" == "link")} {
|
|
|
2073 catch "option readfile $xfCounter2/$xfCounter1 $xfPriority"
|
|
|
2074 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
2075 XFParseAppDefs $xfCounter2/$xfCounter1
|
|
|
2076 } {
|
|
|
2077 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
2078 XFLocalParseAppDefs $xfCounter2/$xfCounter1
|
|
|
2079 }
|
|
|
2080 }
|
|
|
2081 }
|
|
|
2082 }
|
|
|
2083 }
|
|
|
2084 }
|
|
|
2085 } {
|
|
|
2086 # load a specific application defaults file
|
|
|
2087 if {[file exists $xfAppDefFile] &&
|
|
|
2088 [file readable $xfAppDefFile] &&
|
|
|
2089 ("[file type $xfAppDefFile]" == "file" ||
|
|
|
2090 "[file type $xfAppDefFile]" == "link")} {
|
|
|
2091 catch "option readfile $xfAppDefFile $xfPriority"
|
|
|
2092 if {"[info commands XFParseAppDefs]" != ""} {
|
|
|
2093 XFParseAppDefs $xfAppDefFile
|
|
|
2094 } {
|
|
|
2095 if {"[info commands XFLocalParseAppDefs]" != ""} {
|
|
|
2096 XFLocalParseAppDefs $xfAppDefFile
|
|
|
2097 }
|
|
|
2098 }
|
|
|
2099 }
|
|
|
2100 }
|
|
|
2101 }
|
|
|
2102
|
|
|
2103 # application setting procedure
|
|
|
2104 proc XFLocalSetAppDefs {{xfWidgetPath "."}} {
|
|
|
2105 global xfAppDefaults
|
|
|
2106
|
|
|
2107 if {![info exists xfAppDefaults]} {
|
|
|
2108 return
|
|
|
2109 }
|
|
|
2110 foreach xfCounter $xfAppDefaults {
|
|
|
2111 if {"$xfCounter" == ""} {
|
|
|
2112 break
|
|
|
2113 }
|
|
|
2114 set widname [lindex $xfCounter 0]
|
|
|
2115 if {[string match $widname ${xfWidgetPath}] ||
|
|
|
2116 [string match "${xfWidgetPath}*" $widname]} {
|
|
|
2117 set name [string tolower [lindex $xfCounter 1]]
|
|
|
2118 set value [lindex $xfCounter 2]
|
|
|
2119 # Now lets see how many tcl commands match the name
|
|
|
2120 # pattern specified.
|
|
|
2121 set widlist [info command $widname]
|
|
|
2122 if {"$widlist" != ""} {
|
|
|
2123 foreach widget $widlist {
|
|
|
2124 # make sure this command is a widget.
|
|
|
2125 if {![catch "winfo id $widget"] &&
|
|
|
2126 [string match "${xfWidgetPath}*" $widget]} {
|
|
|
2127 catch "$widget configure -$name $value"
|
|
|
2128 }
|
|
|
2129 }
|
|
|
2130 }
|
|
|
2131 }
|
|
|
2132 }
|
|
|
2133 }
|
|
|
2134
|
|
|
2135
|
|
|
2136 # prepare auto loading
|
|
|
2137 global auto_path
|
|
|
2138 global tk_library
|
|
|
2139 global xfLoadPath
|
|
|
2140 foreach xfElement [eval list [split $xfLoadPath :] $auto_path] {
|
|
|
2141 if {[file exists $xfElement/tclIndex]} {
|
|
|
2142 lappend auto_path $xfElement
|
|
|
2143 }
|
|
|
2144 }
|
|
|
2145 catch "unset auto_index"
|
|
|
2146
|
|
|
2147 catch "unset auto_oldpath"
|
|
|
2148
|
|
|
2149 catch "unset auto_execs"
|
|
|
2150
|
|
|
2151
|
|
|
2152 # initialize global variables
|
|
|
2153 proc InitGlobals {} {
|
|
|
2154 global {checkbutton5}
|
|
|
2155 set {checkbutton5} {0}
|
|
|
2156 global {fsBox}
|
|
|
2157 set {fsBox(activeBackground)} {}
|
|
|
2158 set {fsBox(activeForeground)} {}
|
|
|
2159 set {fsBox(all)} {0}
|
|
|
2160 set {fsBox(background)} {}
|
|
|
2161 set {fsBox(button)} {0}
|
|
|
2162 set {fsBox(extensions)} {0}
|
|
|
2163 set {fsBox(font)} {}
|
|
|
2164 set {fsBox(foreground)} {}
|
|
|
2165 set {fsBox(internalPath)} {/user/kono/ITL/demo}
|
|
|
2166 set {fsBox(name)} {ahoaho}
|
|
|
2167 set {fsBox(path)} {/user/kono/ITL/demo}
|
|
|
2168 set {fsBox(pattern)} {*}
|
|
|
2169 set {fsBox(scrollActiveForeground)} {}
|
|
|
2170 set {fsBox(scrollBackground)} {}
|
|
|
2171 set {fsBox(scrollForeground)} {}
|
|
|
2172 set {fsBox(scrollSide)} {left}
|
|
|
2173 set {fsBox(showPixmap)} {0}
|
|
|
2174 global {inputBox}
|
|
|
2175 set {inputBox(activeBackground)} {}
|
|
|
2176 set {inputBox(activeForeground)} {}
|
|
|
2177 set {inputBox(anchor)} {n}
|
|
|
2178 set {inputBox(background)} {}
|
|
|
2179 set {inputBox(erase)} {1}
|
|
|
2180 set {inputBox(font)} {}
|
|
|
2181 set {inputBox(foreground)} {}
|
|
|
2182 set {inputBox(justify)} {center}
|
|
|
2183 set {inputBox(scrollActiveForeground)} {}
|
|
|
2184 set {inputBox(scrollBackground)} {}
|
|
|
2185 set {inputBox(scrollForeground)} {}
|
|
|
2186 set {inputBox(scrollSide)} {left}
|
|
|
2187 set {inputBox(toplevelName)} {.inputBox}
|
|
|
2188 global {scalex}
|
|
|
2189 set {scalex} {326}
|
|
|
2190 global {scaley}
|
|
|
2191 set {scaley} {194}
|
|
|
2192 global {verbose}
|
|
|
2193 set {verbose} {0}
|
|
|
2194
|
|
|
2195 # please don't modify the following
|
|
|
2196 # variables. They are needed by xf.
|
|
|
2197 global {autoLoadList}
|
|
|
2198 set {autoLoadList(xf-disp)} {0}
|
|
|
2199 global {internalAliasList}
|
|
|
2200 set {internalAliasList} {}
|
|
|
2201 global {moduleList}
|
|
|
2202 set {moduleList(xf-disp)} {}
|
|
|
2203 global {preloadList}
|
|
|
2204 set {preloadList(xfInternal)} {}
|
|
|
2205 global {symbolicName}
|
|
|
2206 set {symbolicName(canvas)} {.top0.frame0.canvas2}
|
|
|
2207 set {symbolicName(diag)} {.top0.frame6.button8}
|
|
|
2208 set {symbolicName(entry)} {.frame.frame4.text0}
|
|
|
2209 set {symbolicName(execute)} {.top0.frame6.button10}
|
|
|
2210 set {symbolicName(generate)} {.top0.frame1.button0}
|
|
|
2211 set {symbolicName(map)} {.top0.frame1.button13}
|
|
|
2212 set {symbolicName(root)} {.}
|
|
|
2213 set {symbolicName(states)} {.top0.frame1.label6}
|
|
|
2214 set {symbolicName(verbose)} {.frame3.checkbutton5}
|
|
|
2215 set {symbolicName(verify)} {.frame3.button7}
|
|
|
2216 global {xfWmSetPosition}
|
|
|
2217 set {xfWmSetPosition} {}
|
|
|
2218 global {xfWmSetSize}
|
|
|
2219 set {xfWmSetSize} {}
|
|
|
2220 global {xfAppDefToplevels}
|
|
|
2221 set {xfAppDefToplevels} {}
|
|
|
2222 }
|
|
|
2223
|
|
|
2224 # initialize global variables
|
|
|
2225 InitGlobals
|
|
|
2226
|
|
|
2227 # display/remove toplevel windows.
|
|
|
2228 ShowWindow.
|
|
|
2229
|
|
|
2230 global xfShowWindow.top0
|
|
|
2231 set xfShowWindow.top0 1
|
|
|
2232 ShowWindow.top0
|
|
|
2233
|
|
|
2234 # load default bindings.
|
|
|
2235 if {[info exists env(XF_BIND_FILE)] &&
|
|
|
2236 "[info procs XFShowHelp]" == ""} {
|
|
|
2237 source $env(XF_BIND_FILE)
|
|
|
2238 }
|
|
|
2239
|
|
|
2240 # parse and apply application defaults.
|
|
|
2241 XFLocalLoadAppDefs Xf-disp
|
|
|
2242 XFLocalSetAppDefs
|
|
|
2243
|
|
|
2244 # eof
|
|
|
2245 #
|
|
|
2246
|
