OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [dejagnu/] [contrib/] [testit] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
#!/usr/latest/bin/wish -f
2 
# Program: testit
3 
# Tcl version: 7.2 (Tcl/Tk/XF)
4 
# Tk version: 3.5
5 
# XF version: 2.2
6 
#
7 
 
8 
 
9 
# procedure to show window .
10 
proc ShowWindow. {args} {# xf ignore me 7
11 
 
12 
  # Window manager configurations
13 
  global tkVersion
14 
  wm positionfrom . user
15 
  wm sizefrom . ""
16 
  wm maxsize . 1152 900
17 
  wm title . {xf}
18 
 
19 
  # bindings
20 
  bind .  {MenuPopupPost .frame0.menubutton3.m.menu4 %X %Y}
21 
  bind .  {MenuPopupRelease .frame0.menubutton3.m.menu4 %W}
22 
 
23 
  # build widget .frame0
24 
  frame .frame0 \
25 
    -background {white} \
26 
    -borderwidth {2} \
27 
    -relief {raised}
28 
 
29 
  # build widget .frame0.menubutton0
30 
  menubutton .frame0.menubutton0 \
31 
    -background {white} \
32 
    -foreground {black} \
33 
    -menu {.frame0.menubutton0.m} \
34 
    -text {Summaries}
35 
 
36 
  # build widget .frame0.menubutton0.m
37 
  menu .frame0.menubutton0.m \
38 
    -background {white} \
39 
    -foreground {black}
40 
  .frame0.menubutton0.m add command \
41 
    -command {loadfile $testbase/objdir/$host/$target/logs/gcc.sum
42 
 
43 
} \
44 
    -label {Gcc}
45 
  .frame0.menubutton0.m add command \
46 
    -command {loadfile $testbase/objdir/$host/$target/logs/g++.sum
47 
 
48 
} \
49 
    -label {G++}
50 
  .frame0.menubutton0.m add command \
51 
    -command {loadfile $testbase/objdir/$host/$target/logs/gdb.sum
52 
 
53 
} \
54 
    -label {Gdb}
55 
  .frame0.menubutton0.m add command \
56 
    -command {loadfile $testbase/objdir/$host/$target/logs/gas.sum
57 
 
58 
} \
59 
    -label {Gas}
60 
  .frame0.menubutton0.m add command \
61 
    -command {loadfile $testbase/objdir/$host/$target/logs/binutils.sum
62 
 
63 
} \
64 
    -label {Binutils}
65 
  .frame0.menubutton0.m add command \
66 
    -command {loadfile $testbase/objdir/$host/$target/logs/runtest.sum
67 
 
68 
} \
69 
    -label {Runtest}
70 
  .frame0.menubutton0.m add command \
71 
    -command {loadfile $testbase/objdir/$host/$target/logs/tcl.sum
72 
 
73 
} \
74 
    -label {Tcl}
75 
  .frame0.menubutton0.m add command \
76 
    -command {loadfile $testbase/objdir/$host/$target/logs/expect.sum
77 
 
78 
} \
79 
    -label {Expect}
80 
  .frame0.menubutton0.m add command \
81 
    -command {loadfile $testbase/objdir/$host/$target/logs/libg++.sum
82 
 
83 
} \
84 
    -label {Libg++}
85 
  .frame0.menubutton0.m add command \
86 
    -command {loadfile $testbase/objdir/$host/$target/logs/libio.sum
87 
 
88 
} \
89 
    -label {Libio}
90 
  .frame0.menubutton0.m add command \
91 
    -command {loadfile $testbase/objdir/$host/$target/logs/libm.sum
92 
 
93 
} \
94 
    -label {Libm}
95 
 
96 
  # build widget .frame0.menubutton1
97 
  menubutton .frame0.menubutton1 \
98 
    -background {white} \
99 
    -foreground {black} \
100 
    -menu {.frame0.menubutton1.m} \
101 
    -text {Misc}
102 
 
103 
  # build widget .frame0.menubutton1.m
104 
  menu .frame0.menubutton1.m \
105 
    -background {white} \
106 
    -foreground {black}
107 
  .frame0.menubutton1.m add command \
108 
    -command {EndSrc
109 
destroy .} \
110 
    -label {Exit}
111 
  .frame0.menubutton1.m add command \
112 
    -command {.frame6.frame.text2 delete 0.0 end} \
113 
    -label {Clear window}
114 
  .frame0.menubutton1.m add command \
115 
    -command {dialogbox} \
116 
    -label {Editor}
117 
  .frame0.menubutton1.m add command \
118 
    -command {.frame6.frame.text2 insert 0.0 "Top of tree is $testbase\n"} \
119 
    -label {Show filename}
120 
 
121 
  # build widget .frame0.menubutton3
122 
  menubutton .frame0.menubutton3 \
123 
    -background {white} \
124 
    -foreground {black} \
125 
    -menu {.frame0.menubutton3.m} \
126 
    -text {Host}
127 
 
128 
  # build widget .frame0.menubutton3.m
129 
  menu .frame0.menubutton3.m \
130 
    -background {white} \
131 
    -foreground {black}
132 
  .frame0.menubutton3.m add command \
133 
    -command {set host "alpha-dec-osf1.3"} \
134 
    -label {alpha-dec-osf1.3}
135 
  .frame0.menubutton3.m add command \
136 
    -command {set host "hppa1.1-hp-hpux"} \
137 
    -label {hppa1.1-hp-hpux}
138 
  .frame0.menubutton3.m add command \
139 
    -command {set host "i386-unknown-sysv4.2"} \
140 
    -label {i386-unknown-sysv4.2}
141 
  .frame0.menubutton3.m add command \
142 
    -command {set host "m68k-hp-hpux"} \
143 
    -label {m68k-hp-hpux}
144 
  .frame0.menubutton3.m add command \
145 
    -command {set host "m68k-sun-sunos4.1.1"} \
146 
    -label {m68k-sun-sunos4.1.1}
147 
  .frame0.menubutton3.m add command \
148 
    -command {set host "mips-dec-ultrix4.2"} \
149 
    -label {mips-dec-ultrix4.2}
150 
  .frame0.menubutton3.m add command \
151 
    -command {set host "mips-sgi-irix4.0.5H"} \
152 
    -label {mips-sgi-irix4.0.5H}
153 
  .frame0.menubutton3.m add command \
154 
    -command {set host "rs6000-ibm-aix3.2"} \
155 
    -label {rs6000-ibm-aix3.2}
156 
  .frame0.menubutton3.m add command \
157 
    -command {set host "sparc-sun-solaris2.3"} \
158 
    -label {sparc-sun-solaris2.3}
159 
  .frame0.menubutton3.m add command \
160 
    -command {set host "sparc-sun-sunos4.1.3"} \
161 
    -label {sparc-sun-sunos4.1.3}
162 
 
163 
  # build widget .frame0.menubutton2
164 
  menubutton .frame0.menubutton2 \
165 
    -background {white} \
166 
    -foreground {black} \
167 
    -menu {.frame0.menubutton2.m} \
168 
    -text {Target}
169 
 
170 
  # build widget .frame0.menubutton2.m
171 
  menu .frame0.menubutton2.m \
172 
    -background {white} \
173 
    -foreground {black}
174 
  .frame0.menubutton2.m add command \
175 
    -command {set target  "a29k-amd-udi"} \
176 
    -label {a29k-amd-udi}
177 
  .frame0.menubutton2.m add command \
178 
    -command {set target  "h8300-hms"} \
179 
    -label {h8300-hms}
180 
  .frame0.menubutton2.m add command \
181 
    -command {set target  "i386-aout"} \
182 
    -label {i386-aout}
183 
  .frame0.menubutton2.m add command \
184 
    -command {set target  "i386-lynx"} \
185 
    -label {i386-lynx}
186 
  .frame0.menubutton2.m add command \
187 
    -command {set target  "i960-intel-nindy"} \
188 
    -label {i960-intel-nindy}
189 
  .frame0.menubutton2.m add command \
190 
    -command {set target  "i960-vxwork"} \
191 
    -label {i960-vxworks}
192 
  .frame0.menubutton2.m add command \
193 
    -command {set target  "m68k-aout"} \
194 
    -label {m68k-aout}
195 
  .frame0.menubutton2.m add command \
196 
    -command {set target  "m68k-coff"} \
197 
    -label {m68k-coff}
198 
  .frame0.menubutton2.m add command \
199 
    -command {set target  "m68k-lynx"} \
200 
    -label {m68k-lynx}
201 
  .frame0.menubutton2.m add command \
202 
    -command {set target  "m68k-vxworks"} \
203 
    -label {m68k-vxworks}
204 
  .frame0.menubutton2.m add command \
205 
    -command {set target  "mips-idt-ecoff"} \
206 
    -label {mips-idt-ecoff}
207 
  .frame0.menubutton2.m add command \
208 
    -command {set target  "sh-hms"} \
209 
    -label {sh-hms}
210 
  .frame0.menubutton2.m add command \
211 
    -command {set target  "sparc-aout"} \
212 
    -label {sparc-aout}
213 
  .frame0.menubutton2.m add command \
214 
    -command {set target  "sparc-sun-sunos4.1.3"} \
215 
    -label {sparc-sun-sunos4.1.3}
216 
  .frame0.menubutton2.m add command \
217 
    -command {set target  "sparc-vxworks"} \
218 
    -label {sparc-vxworks}
219 
  .frame0.menubutton2.m add command \
220 
    -command {set target  "sparclite-aout"} \
221 
    -label {sparclite-aout}
222 
  .frame0.menubutton2.m add command \
223 
    -command {set target  "sparclite-coff"} \
224 
    -label {sparclite-coff}
225 
  .frame0.menubutton2.m add command \
226 
    -command {set target  "hppa1.1-hp-hpux"} \
227 
    -label {hppa1.1-hp-hpux}
228 
  .frame0.menubutton2.m add command \
229 
    -command {set target  "i386-unknown-sysv4.2"} \
230 
    -label {i386-unknown-sysv4.2}
231 
  .frame0.menubutton2.m add command \
232 
    -command {set target  "m68k-hp-hpux"} \
233 
    -label {m68k-hp-hpux}
234 
  .frame0.menubutton2.m add command \
235 
    -command {set target  "m68k-sun-sunos4.1.1"} \
236 
    -label {m68k-sun-sunos4.1.1}
237 
  .frame0.menubutton2.m add command \
238 
    -command {set target  "mips-dec-ultrix4.2"} \
239 
    -label {mips-dec-ultrix4.2}
240 
  .frame0.menubutton2.m add command \
241 
    -command {set target  "mips-sgi-irix4.0.5H"} \
242 
    -label {mips-sgi-irix4.0.5H}
243 
  .frame0.menubutton2.m add command \
244 
    -command {set target  "rs6000-ibm-aix3.2"} \
245 
    -label {rs6000-ibm-aix3.2}
246 
  .frame0.menubutton2.m add command \
247 
    -command {set target  "sparc-sun-solaris2.3"} \
248 
    -label {sparc-sun-solaris2.3}
249 
 
250 
  # build widget .frame0.menubutton9
251 
  menubutton .frame0.menubutton9 \
252 
    -background {white} \
253 
    -foreground {black} \
254 
    -menu {.frame0.menubutton9.m} \
255 
    -text {Results}
256 
 
257 
  # build widget .frame0.menubutton9.m
258 
  menu .frame0.menubutton9.m \
259 
    -background {white} \
260 
    -foreground {black}
261 
  .frame0.menubutton9.m add command \
262 
    -command {getresult $testbase/objdir/$host/$target/logs/gcc
263 
 
264 
} \
265 
    -label {Gcc}
266 
  .frame0.menubutton9.m add command \
267 
    -command {getresult $testbase/objdir/$host/$target/logs/g++
268 
 
269 
} \
270 
    -label {G++}
271 
  .frame0.menubutton9.m add command \
272 
    -command {getresult $testbase/objdir/$host/$target/logs/gdb
273 
 
274 
} \
275 
    -label {Gdb}
276 
  .frame0.menubutton9.m add command \
277 
    -command {getresult $testbase/objdir/$host/$target/logs/gas
278 
 
279 
} \
280 
    -label {Gas}
281 
  .frame0.menubutton9.m add command \
282 
    -command {getresult $testbase/objdir/$host/$target/logs/binutils
283 
 
284 
} \
285 
    -label {Binutils}
286 
  .frame0.menubutton9.m add command \
287 
    -command {getresult $testbase/objdir/$host/$target/logs/runtest
288 
} \
289 
    -label {Runtest}
290 
  .frame0.menubutton9.m add command \
291 
    -command {getresult $testbase/objdir/$host/$target/logs/tcl
292 
 
293 
} \
294 
    -label {Tcl}
295 
  .frame0.menubutton9.m add command \
296 
    -command {getresult $testbase/objdir/$host/$target/logs/expect
297 
 
298 
} \
299 
    -label {Expect}
300 
  .frame0.menubutton9.m add command \
301 
    -command {getresult $testbase/objdir/$host/$target/logs/libg++
302 
 
303 
} \
304 
    -label {Libg++}
305 
  .frame0.menubutton9.m add command \
306 
    -command {getresult $testbase/objdir/$host/$target/logs/libio
307 
} \
308 
    -label {Libio}
309 
  .frame0.menubutton9.m add command \
310 
    -command {getresult $testbase/objdir/$host/$target/logs/libm
311 
 
312 
} \
313 
    -label {Libm}
314 
 
315 
  # build widget .frame0.menubutton10
316 
  menubutton .frame0.menubutton10 \
317 
    -background {white} \
318 
    -foreground {black} \
319 
    -menu {.frame0.menubutton10.m} \
320 
    -text {Logs}
321 
 
322 
  # build widget .frame0.menubutton10.m
323 
  menu .frame0.menubutton10.m \
324 
    -background {white} \
325 
    -foreground {black}
326 
  .frame0.menubutton10.m add command \
327 
    -command {loadfile $testbase/objdir/$host/$target/logs/gcc.log
328 
 
329 
} \
330 
    -label {Gcc}
331 
  .frame0.menubutton10.m add command \
332 
    -command {loadfile $testbase/objdir/$host/$target/logs/g++.log
333 
 
334 
} \
335 
    -label {G++}
336 
  .frame0.menubutton10.m add command \
337 
    -command {loadfile $testbase/objdir/$host/$target/logs/gdb.log
338 
 
339 
} \
340 
    -label {Gdb}
341 
  .frame0.menubutton10.m add command \
342 
    -command {loadfile $testbase/objdir/$host/$target/logs/gas.log
343 
 
344 
} \
345 
    -label {Gas}
346 
  .frame0.menubutton10.m add command \
347 
    -command {loadfile $testbase/objdir/$host/$target/logs/binutils.log
348 
 
349 
} \
350 
    -label {Binutils}
351 
  .frame0.menubutton10.m add command \
352 
    -command {loadfile $testbase/objdir/$host/$target/logs/runtest.log
353 
 
354 
} \
355 
    -label {Runtest}
356 
  .frame0.menubutton10.m add command \
357 
    -command {loadfile $testbase/objdir/$host/$target/logs/tcl.log
358 
 
359 
} \
360 
    -label {Tcl}
361 
  .frame0.menubutton10.m add command \
362 
    -command {loadfile $testbase/objdir/$host/$target/logs/expect.log
363 
 
364 
} \
365 
    -label {Expect}
366 
  .frame0.menubutton10.m add command \
367 
    -command {loadfile $testbase/objdir/$host/$target/logs/libg++.log
368 
 
369 
} \
370 
    -label {Libg++}
371 
  .frame0.menubutton10.m add command \
372 
    -command {loadfile $testbase/objdir/$host/$target/logs/libio.log
373 
 
374 
} \
375 
    -label {Libio}
376 
  .frame0.menubutton10.m add command \
377 
    -command {loadfile $testbase/objdir/$host/$target/logs/libm.log
378 
 
379 
} \
380 
    -label {Libm}
381 
 
382 
  # pack widget .frame0
383 
  pack append .frame0 \
384 
    .frame0.menubutton0 {left frame center} \
385 
    .frame0.menubutton1 {right frame center} \
386 
    .frame0.menubutton3 {left frame center} \
387 
    .frame0.menubutton2 {left frame center} \
388 
    .frame0.menubutton9 {left frame center} \
389 
    .frame0.menubutton10 {left frame center}
390 
 
391 
  # build widget .frame1
392 
  frame .frame1 \
393 
    -background {white} \
394 
    -borderwidth {2} \
395 
    -relief {raised}
396 
 
397 
  # build widget .frame1.message3
398 
  message .frame1.message3 \
399 
    -aspect {1500} \
400 
    -background {white} \
401 
    -borderwidth {0} \
402 
    -foreground {black} \
403 
    -padx {5} \
404 
    -pady {2} \
405 
    -relief {raised} \
406 
    -text {sparc-sun-sunos4.1.3} \
407 
    -textvariable {host}
408 
 
409 
  # build widget .frame1.message4
410 
  message .frame1.message4 \
411 
    -aspect {1500} \
412 
    -background {white} \
413 
    -borderwidth {0} \
414 
    -foreground {black} \
415 
    -padx {5} \
416 
    -pady {2} \
417 
    -relief {raised} \
418 
    -text {sparc-sun-sunos4.1.3} \
419 
    -textvariable {target}
420 
 
421 
  # pack widget .frame1
422 
  pack append .frame1 \
423 
    .frame1.message3 {left frame center} \
424 
    .frame1.message4 {right frame center}
425 
 
426 
  # build widget .frame6
427 
  frame .frame6 \
428 
    -background {white} \
429 
    -borderwidth {2} \
430 
    -relief {raised}
431 
 
432 
  # build widget .frame6.frame
433 
  frame .frame6.frame \
434 
    -background {white} \
435 
    -relief {raised}
436 
 
437 
  # build widget .frame6.frame.scrollbar1
438 
  scrollbar .frame6.frame.scrollbar1 \
439 
    -background {white} \
440 
    -command {.frame6.frame.text2 yview} \
441 
    -foreground {black} \
442 
    -relief {raised}
443 
 
444 
  # build widget .frame6.frame.text2
445 
  text .frame6.frame.text2 \
446 
    -background {white} \
447 
    -borderwidth {2} \
448 
    -foreground {black} \
449 
    -relief {raised} \
450 
    -wrap {word} \
451 
    -yscrollcommand {.frame6.frame.scrollbar1 set}
452 
 
453 
  # pack widget .frame6.frame
454 
  pack append .frame6.frame \
455 
    .frame6.frame.scrollbar1 {left frame center filly} \
456 
    .frame6.frame.text2 {top frame center expand fill}
457 
 
458 
  # pack widget .frame6
459 
  pack append .frame6 \
460 
    .frame6.frame {top frame center fill}
461 
 
462 
  # pack widget .
463 
  pack append . \
464 
    .frame0 {top frame center fillx} \
465 
    .frame1 {bottom frame center fillx} \
466 
    .frame6 {top frame center expand fill}
467 
 
468 
  .frame6.frame.text2 insert end {}
469 
 
470 
 
471 
 
472 
  if {"[info procs XFEdit]" != ""} {
473 
    catch "XFMiscBindWidgetTree ."
474 
    after 2 "catch {XFEditSetShowWindows}"
475 
  }
476 
}
477 
 
478 
 
479 
# Procedure: Alias
480 
if {"[info procs Alias]" == ""} {
481 
proc Alias { args} {
482 
# xf ignore me 7
483 
##########
484 
# Procedure: Alias
485 
# Description: establish an alias for a procedure
486 
# Arguments: args - no argument means that a list of all aliases
487 
#                   is returned. Otherwise the first parameter is
488 
#                   the alias name, and the second parameter is
489 
#                   the procedure that is aliased.
490 
# Returns: nothing, the command that is bound to the alias or a
491 
#          list of all aliases - command pairs.
492 
# Sideeffects: internalAliasList is updated, and the alias
493 
#              proc is inserted
494 
##########
495 
  global internalAliasList
496 
 
497 
  if {[llength $args] == 0} {
498 
    return $internalAliasList
499 
  } {
500 
    if {[llength $args] == 1} {
501 
      set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
502 
      if {$xfTmpIndex != -1} {
503 
        return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
504 
      }
505 
    } {
506 
      if {[llength $args] == 2} {
507 
        eval "proc [lindex $args 0] {args} {#xf ignore me 4
508 
return \[eval \"[lindex $args 1] \$args\"\]}"
509 
        set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
510 
        if {$xfTmpIndex != -1} {
511 
          set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
512 
        } {
513 
          lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
514 
        }
515 
      } {
516 
        error "Alias: wrong number or args: $args"
517 
      }
518 
    }
519 
  }
520 
}
521 
}
522 
 
523 
 
524 
# Procedure: GetSelection
525 
if {"[info procs GetSelection]" == ""} {
526 
proc GetSelection {} {
527 
# xf ignore me 7
528 
##########
529 
# Procedure: GetSelection
530 
# Description: get current selection
531 
# Arguments: none
532 
# Returns: none
533 
# Sideeffects: none
534 
##########
535 
 
536 
  # the save way
537 
  set xfSelection ""
538 
  catch "selection get" xfSelection
539 
  if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
540 
    return ""
541 
  } {
542 
    return $xfSelection
543 
  }
544 
}
545 
}
546 
 
547 
 
548 
# Procedure: MenuPopupAdd
549 
if {"[info procs MenuPopupAdd]" == ""} {
550 
proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} {
551 
# xf ignore me 7
552 
# the popup menu handling is from (I already gave up with popup handling :-):
553 
#
554 
# Copyright 1991,1992 by James Noble.
555 
# Everyone is granted permission to copy, modify and redistribute.
556 
# This notice must be preserved on all copies or derivates.
557 
#
558 
##########
559 
# Procedure: MenuPopupAdd
560 
# Description: attach a popup menu to widget
561 
# Arguments: xfW - the widget
562 
#            xfButton - the button we use
563 
#            xfMenu - the menu to attach
564 
#            {xfModifier} - a optional modifier
565 
#            {xfCanvasTag} - a canvas tagOrId
566 
# Returns: none
567 
# Sideeffects: none
568 
##########
569 
  global tk_popupPriv
570 
 
571 
  set tk_popupPriv($xfMenu,focus) ""
572 
  set tk_popupPriv($xfMenu,grab) ""
573 
  if {"$xfModifier" != ""} {
574 
    set press "$xfModifier-"
575 
    set motion "$xfModifier-"
576 
    set release "Any-"
577 
  } {
578 
    set press ""
579 
    set motion ""
580 
    set release ""
581 
  }
582 
 
583 
  bind $xfMenu "<${motion}B${xfButton}-Motion>"  "MenuPopupMotion $xfMenu %W %X %Y"
584 
  bind $xfMenu "<${release}ButtonRelease-${xfButton}>"  "MenuPopupRelease $xfMenu %W"
585 
  if {"$xfCanvasTag" == ""} {
586 
    bind $xfW "<${press}ButtonPress-${xfButton}>"  "MenuPopupPost $xfMenu %X %Y"
587 
    bind $xfW "<${release}ButtonRelease-${xfButton}>"  "MenuPopupRelease $xfMenu %W"
588 
  } {
589 
    $xfW bind $xfCanvasTag "<${press}ButtonPress-${xfButton}>"  "MenuPopupPost $xfMenu %X %Y"
590 
    $xfW bind $xfCanvasTag "<${release}ButtonRelease-${xfButton}>"  "MenuPopupRelease $xfMenu %W"
591 
  }
592 
}
593 
}
594 
 
595 
 
596 
# Procedure: MenuPopupMotion
597 
if {"[info procs MenuPopupMotion]" == ""} {
598 
proc MenuPopupMotion { xfMenu xfW xfX xfY} {
599 
# xf ignore me 7
600 
##########
601 
# Procedure: MenuPopupMotion
602 
# Description: handle the popup menu motion
603 
# Arguments: xfMenu - the topmost menu
604 
#            xfW - the menu
605 
#            xfX - the root x coordinate
606 
#            xfY - the root x coordinate
607 
# Returns: none
608 
# Sideeffects: none
609 
##########
610 
  global tk_popupPriv
611 
 
612 
  if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
613 
      "[winfo class $xfW]" == "Menu" &&
614 
      [info exists tk_popupPriv($xfMenu,focus)] &&
615 
      "$tk_popupPriv($xfMenu,focus)" != "" &&
616 
      [info exists tk_popupPriv($xfMenu,grab)] &&
617 
      "$tk_popupPriv($xfMenu,grab)" != ""} {
618 
    set xfPopMinX [winfo rootx $xfW]
619 
    set xfPopMaxX [expr $xfPopMinX+[winfo width $xfW]]
620 
    if {$xfX >= $xfPopMinX && $xfX <= $xfPopMaxX} {
621 
      $xfW activate @[expr $xfY-[winfo rooty $xfW]]
622 
      if {![catch "$xfW entryconfig @[expr $xfY-[winfo rooty $xfW]] -menu" result]} {
623 
        if {"[lindex $result 4]" != ""} {
624 
          foreach binding [bind $xfMenu] {
625 
            bind [lindex $result 4] $binding [bind $xfMenu $binding]
626 
          }
627 
        }
628 
      }
629 
    } {
630 
      $xfW activate none
631 
    }
632 
  }
633 
}
634 
}
635 
 
636 
 
637 
# Procedure: MenuPopupPost
638 
if {"[info procs MenuPopupPost]" == ""} {
639 
proc MenuPopupPost { xfMenu xfX xfY} {
640 
# xf ignore me 7
641 
##########
642 
# Procedure: MenuPopupPost
643 
# Description: post the popup menu
644 
# Arguments: xfMenu - the menu
645 
#            xfX - the root x coordinate
646 
#            xfY - the root x coordinate
647 
# Returns: none
648 
# Sideeffects: none
649 
##########
650 
  global tk_popupPriv
651 
 
652 
  if {"[info commands $xfMenu]" != ""} {
653 
    if {![info exists tk_popupPriv($xfMenu,focus)]} {
654 
      set tk_popupPriv($xfMenu,focus) [focus]
655 
    } {
656 
      if {"$tk_popupPriv($xfMenu,focus)" == ""} {
657 
        set tk_popupPriv($xfMenu,focus) [focus]
658 
      }
659 
    }
660 
    set tk_popupPriv($xfMenu,grab) $xfMenu
661 
 
662 
    catch "$xfMenu activate none"
663 
    catch "$xfMenu post $xfX $xfY"
664 
    catch "focus $xfMenu"
665 
    catch "grab -global $xfMenu"
666 
  }
667 
}
668 
}
669 
 
670 
 
671 
# Procedure: MenuPopupRelease
672 
if {"[info procs MenuPopupRelease]" == ""} {
673 
proc MenuPopupRelease { xfMenu xfW} {
674 
# xf ignore me 7
675 
##########
676 
# Procedure: MenuPopupRelease
677 
# Description: remove the popup menu
678 
# Arguments: xfMenu - the topmost menu widget
679 
#            xfW - the menu widget
680 
# Returns: none
681 
# Sideeffects: none
682 
##########
683 
  global tk_popupPriv
684 
  global tkVersion
685 
 
686 
  if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] &&
687 
      "[winfo class $xfW]" == "Menu" &&
688 
      [info exists tk_popupPriv($xfMenu,focus)] &&
689 
      "$tk_popupPriv($xfMenu,focus)" != "" &&
690 
      [info exists tk_popupPriv($xfMenu,grab)] &&
691 
      "$tk_popupPriv($xfMenu,grab)" != ""} {
692 
    if {$tkVersion >= 3.0} {
693 
      catch "grab release $tk_popupPriv($xfMenu,grab)"
694 
    } {
695 
      catch "grab none"
696 
    }
697 
    catch "focus $tk_popupPriv($xfMenu,focus)"
698 
    set tk_popupPriv($xfMenu,focus) ""
699 
    set tk_popupPriv($xfMenu,grab) ""
700 
    if {"[$xfW index active]" != "none"} {
701 
      $xfW invoke active; catch "$xfMenu unpost"
702 
    }
703 
  }
704 
  catch "$xfMenu unpost"
705 
}
706 
}
707 
 
708 
 
709 
# Procedure: NoFunction
710 
if {"[info procs NoFunction]" == ""} {
711 
proc NoFunction { args} {
712 
# xf ignore me 7
713 
##########
714 
# Procedure: NoFunction
715 
# Description: do nothing (especially with scales and scrollbars)
716 
# Arguments: args - a number of ignored parameters
717 
# Returns: none
718 
# Sideeffects: none
719 
##########
720 
}
721 
}
722 
 
723 
 
724 
# Procedure: SN
725 
if {"[info procs SN]" == ""} {
726 
proc SN { {xfName ""}} {
727 
# xf ignore me 7
728 
##########
729 
# Procedure: SN
730 
# Description: map a symbolic name to the widget path
731 
# Arguments: xfName
732 
# Returns: the symbolic name
733 
# Sideeffects: none
734 
##########
735 
 
736 
  SymbolicName $xfName
737 
}
738 
}
739 
 
740 
 
741 
# Procedure: SymbolicName
742 
if {"[info procs SymbolicName]" == ""} {
743 
proc SymbolicName { {xfName ""}} {
744 
# xf ignore me 7
745 
##########
746 
# Procedure: SymbolicName
747 
# Description: map a symbolic name to the widget path
748 
# Arguments: xfName
749 
# Returns: the symbolic name
750 
# Sideeffects: none
751 
##########
752 
 
753 
  global symbolicName
754 
 
755 
  if {"$xfName" != ""} {
756 
    set xfArrayName ""
757 
    append xfArrayName symbolicName ( $xfName )
758 
    if {![catch "set \"$xfArrayName\"" xfValue]} {
759 
      return $xfValue
760 
    } {
761 
      if {"[info commands XFProcError]" != ""} {
762 
        XFProcError "Unknown symbolic name:\n$xfName"
763 
      } {
764 
        puts stderr "XF error: unknown symbolic name:\n$xfName"
765 
      }
766 
    }
767 
  }
768 
  return ""
769 
}
770 
}
771 
 
772 
 
773 
# Procedure: Unalias
774 
if {"[info procs Unalias]" == ""} {
775 
proc Unalias { aliasName} {
776 
# xf ignore me 7
777 
##########
778 
# Procedure: Unalias
779 
# Description: remove an alias for a procedure
780 
# Arguments: aliasName - the alias name to remove
781 
# Returns: none
782 
# Sideeffects: internalAliasList is updated, and the alias
783 
#              proc is removed
784 
##########
785 
  global internalAliasList
786 
 
787 
  set xfIndex [lsearch $internalAliasList "$aliasName *"]
788 
  if {$xfIndex != -1} {
789 
    rename $aliasName ""
790 
    set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
791 
  }
792 
}
793 
}
794 
 
795 
 
796 
# Procedure: getbase
797 
proc getbase {} {
798 
  global env
799 
  global testbase
800 
  if [info exists env(TESTBASE)] then {
801 
    set testbase $env(TESTBASE)
802 
  } else {
803 
    set testbase /lisa/test/rob
804 
  }
805 
  return $testbase
806 
}
807 
 
808 
 
809 
# Procedure: getresult
810 
proc getresult { name} {
811 
set tmp "[lsort [glob -nocomplain $name-results-??????-????]]"
812 
set tmp [lindex $tmp [expr [llength $tmp] - 1]]
813 
if [string match "" $tmp] then {
814 
  .frame6.frame.text2 delete 0.0 end
815 
  .frame6.frame.text2 insert 0.0 "Couldn't find results for: $name\n"
816 
  return
817 
} else {
818 
  return [loadfile $tmp]
819 
}
820 
}
821 
 
822 
# Procedure: dialogbox
823 
proc dialogbox {} {
824 
  set w .frame6.top2
825 
  catch {destroy $w}
826 
  catch {destroy $w.e1}
827 
  toplevel $w
828 
#  dpos $w
829 
  wm title $w "Change Editor"
830 
  wm iconname $w "Entries"
831 
  message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 200 \
832 
  -text "Hey Now. Click the \"OK\" button when you've seen enough."
833 
  frame $w.frame -borderwidth 10
834 
  button $w.ok -text OK -command "destroy $w"
835 
  pack $w.msg $w.frame $w.ok -side top -fill both
836 
 
837 
  entry $w.frame.e1 -relief sunken -textvariable editor
838 
  pack $w.frame.e1 -side top -pady 5 -fill x
839 
  bind $w.frame.e1  "destroy $w"
840 
}
841 
 
842 
# Procedure: loadfile
843 
proc loadfile { name} {
844 
if ![file exists $name] then {
845 
  .frame6.frame.text2 delete 0.0 end
846 
  .frame6.frame.text2 insert 0.0 "Couldn't find:\t$name\n"
847 
  return
848 
}
849 
 
850 
global editor
851 
if [info exists editor] then {
852 
  if ![string match "" $editor] then {
853 
    catch "exec $editor $name&" tmp
854 
    if [info exists tmp] then {
855 
       .frame6.frame.text2 delete 0.0 end
856 
       .frame6.frame.text2 insert 0.0 "Editor returned $tmp\n"
857 
    }
858 
  }
859 
}
860 
.frame6.frame.text2 delete 0.0 end
861 
set fd [open $name r]
862 
while { [gets $fd line]>=0 } {
863 
.frame6.frame.text2 insert end "$line\n"
864 
.frame6.frame.text2 mark set insert 0.0
865 
}
866 
close $fd
867 
unset fd
868 
}
869 
 
870 
 
871 
 
872 
# application parsing procedure
873 
proc XFLocalParseAppDefs {xfAppDefFile} {
874 
  global xfAppDefaults
875 
 
876 
  # basically from: Michael Moore
877 
  if {[file exists $xfAppDefFile] &&
878 
      [file readable $xfAppDefFile] &&
879 
      "[file type $xfAppDefFile]" == "link"} {
880 
    catch "file type $xfAppDefFile" xfType
881 
    while {"$xfType" == "link"} {
882 
      if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} {
883 
        return
884 
      }
885 
      catch "file type $xfAppDefFile" xfType
886 
    }
887 
  }
888 
  if {!("$xfAppDefFile" != "" &&
889 
        [file exists $xfAppDefFile] &&
890 
        [file readable $xfAppDefFile] &&
891 
        "[file type $xfAppDefFile]" == "file")} {
892 
    return
893 
  }
894 
  if {![catch "open $xfAppDefFile r" xfResult]} {
895 
    set xfAppFileContents [read $xfResult]
896 
    close $xfResult
897 
    foreach line [split $xfAppFileContents "\n"] {
898 
      # backup indicates how far to backup.  It applies to the
899 
      # situation where a resource name ends in . and when it
900 
      # ends in *.  In the second case you want to keep the *
901 
      # in the widget name for pattern matching, but you want
902 
      # to get rid of the . if it is the end of the name.
903 
      set backup -2
904 
      set line [string trim $line]
905 
      if {[string index $line 0] == "#" || "$line" == ""} {
906 
        # skip comments and empty lines
907 
        continue
908 
      }
909 
      set list [split $line ":"]
910 
      set resource [string trim [lindex $list 0]]
911 
      set i [string last "." $resource]
912 
      set j [string last "*" $resource]
913 
      if {$j > $i} {
914 
        set i $j
915 
        set backup -1
916 
      }
917 
      incr i
918 
      set name [string range $resource $i end]
919 
      incr i $backup
920 
      set widname [string range $resource 0 $i]
921 
      set value [string trim [lindex $list 1]]
922 
      if {"$widname" != "" && "$widname" != "*"} {
923 
        # insert the widget and resourcename to the application
924 
        # defaults list.
925 
        if {![info exists xfAppDefaults]} {
926 
          set xfAppDefaults ""
927 
        }
928 
        lappend xfAppDefaults [list $widname [string tolower $name] $value]
929 
      }
930 
    }
931 
  }
932 
}
933 
 
934 
# application loading procedure
935 
proc XFLocalLoadAppDefs {{xfClasses ""} {xfPriority "startupFile"} {xfAppDefFile ""}} {
936 
  global env
937 
 
938 
  if {"$xfAppDefFile" == ""} {
939 
    set xfFileList ""
940 
    if {[info exists env(XUSERFILESEARCHPATH)]} {
941 
      append xfFileList [split $env(XUSERFILESEARCHPATH) :]
942 
    }
943 
    if {[info exists env(XAPPLRESDIR)]} {
944 
      append xfFileList [split $env(XAPPLRESDIR) :]
945 
    }
946 
    if {[info exists env(XFILESEARCHPATH)]} {
947 
      append xfFileList [split $env(XFILESEARCHPATH) :]
948 
    }
949 
    append xfFileList " /usr/lib/X11/app-defaults"
950 
    append xfFileList " /usr/X11/lib/X11/app-defaults"
951 
 
952 
    foreach xfCounter1 $xfClasses {
953 
      foreach xfCounter2 $xfFileList {
954 
        set xfPathName $xfCounter2
955 
        if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} {
956 
          set xfPathName $xfResult
957 
        }
958 
        if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} {
959 
          set xfPathName $xfResult
960 
        }
961 
        if {[regsub -all "%S" "$xfPathName" "" xfResult]} {
962 
          set xfPathName $xfResult
963 
        }
964 
        if {[regsub -all "%C" "$xfPathName" "" xfResult]} {
965 
          set xfPathName $xfResult
966 
        }
967 
        if {[file exists $xfPathName] &&
968 
            [file readable $xfPathName] &&
969 
            ("[file type $xfPathName]" == "file" ||
970 
             "[file type $xfPathName]" == "link")} {
971 
          catch "option readfile $xfPathName $xfPriority"
972 
          if {"[info commands XFParseAppDefs]" != ""} {
973 
            XFParseAppDefs $xfPathName
974 
          } {
975 
            if {"[info commands XFLocalParseAppDefs]" != ""} {
976 
              XFLocalParseAppDefs $xfPathName
977 
            }
978 
          }
979 
        } {
980 
          if {[file exists $xfCounter2/$xfCounter1] &&
981 
              [file readable $xfCounter2/$xfCounter1] &&
982 
              ("[file type $xfCounter2/$xfCounter1]" == "file" ||
983 
               "[file type $xfCounter2/$xfCounter1]" == "link")} {
984 
            catch "option readfile $xfCounter2/$xfCounter1 $xfPriority"
985 
            if {"[info commands XFParseAppDefs]" != ""} {
986 
              XFParseAppDefs $xfCounter2/$xfCounter1
987 
            } {
988 
              if {"[info commands XFLocalParseAppDefs]" != ""} {
989 
                XFLocalParseAppDefs $xfCounter2/$xfCounter1
990 
              }
991 
            }
992 
          }
993 
        }
994 
      }
995 
    }
996 
  } {
997 
    # load a specific application defaults file
998 
    if {[file exists $xfAppDefFile] &&
999 
        [file readable $xfAppDefFile] &&
1000 
        ("[file type $xfAppDefFile]" == "file" ||
1001 
         "[file type $xfAppDefFile]" == "link")} {
1002 
      catch "option readfile $xfAppDefFile $xfPriority"
1003 
      if {"[info commands XFParseAppDefs]" != ""} {
1004 
        XFParseAppDefs $xfAppDefFile
1005 
      } {
1006 
        if {"[info commands XFLocalParseAppDefs]" != ""} {
1007 
          XFLocalParseAppDefs $xfAppDefFile
1008 
        }
1009 
      }
1010 
    }
1011 
  }
1012 
}
1013 
 
1014 
# application setting procedure
1015 
proc XFLocalSetAppDefs {{xfWidgetPath "."}} {
1016 
  global xfAppDefaults
1017 
 
1018 
  if {![info exists xfAppDefaults]} {
1019 
    return
1020 
  }
1021 
  foreach xfCounter $xfAppDefaults {
1022 
    if {"$xfCounter" == ""} {
1023 
      break
1024 
    }
1025 
    set widname [lindex $xfCounter 0]
1026 
    if {[string match $widname ${xfWidgetPath}] ||
1027 
        [string match "${xfWidgetPath}*" $widname]} {
1028 
      set name [string tolower [lindex $xfCounter 1]]
1029 
      set value [lindex $xfCounter 2]
1030 
      # Now lets see how many tcl commands match the name
1031 
      # pattern specified.
1032 
      set widlist [info command $widname]
1033 
      if {"$widlist" != ""} {
1034 
        foreach widget $widlist {
1035 
          # make sure this command is a widget.
1036 
          if {![catch "winfo id $widget"] &&
1037 
              [string match "${xfWidgetPath}*" $widget]} {
1038 
            catch "$widget configure -$name $value"
1039 
          }
1040 
        }
1041 
      }
1042 
    }
1043 
  }
1044 
}
1045 
 
1046 
 
1047 
 
1048 
# startup source
1049 
proc StartupSrc {args} {
1050 
global testbase
1051 
global hostlist
1052 
global targlist
1053 
global host
1054 
 
1055 
set host [exec config.guess]
1056 
set target $host
1057 
}
1058 
 
1059 
 
1060 
# end source
1061 
proc EndSrc {} {
1062 
.frame6.frame.text2 delete 0.0 end
1063 
}
1064 
 
1065 
# startup source
1066 
StartupSrc
1067 
 
1068 
# initialize global variables
1069 
global {editor}
1070 
set {editor} {}
1071 
global {fsBox}
1072 
set {fsBox(activeBackground)} {}
1073 
set {fsBox(activeForeground)} {}
1074 
set {fsBox(all)} {0}
1075 
set {fsBox(background)} {}
1076 
set {fsBox(button)} {0}
1077 
set {fsBox(extensions)} {0}
1078 
set {fsBox(font)} {}
1079 
set {fsBox(foreground)} {}
1080 
set {fsBox(internalPath)} {/offsite/rob/DejaGnu/devo/dejagnu}
1081 
set {fsBox(name)} {}
1082 
set {fsBox(path)} {/offsite/rob/DejaGnu/devo/dejagnu}
1083 
set {fsBox(pattern)} {*}
1084 
set {fsBox(scrollActiveForeground)} {}
1085 
set {fsBox(scrollBackground)} {}
1086 
set {fsBox(scrollForeground)} {}
1087 
set {fsBox(scrollSide)} {left}
1088 
set {fsBox(showPixmap)} {0}
1089 
global {host}
1090 
set {host} {sparc-sun-sunos4.1.3}
1091 
global {result}
1092 
set {result} {can't read "editor": no such variable}
1093 
global {target}
1094 
set {target} {sparc-sun-sunos4.1.3}
1095 
global {testbase}
1096 
set {testbase} {/lisa/test/rob}
1097 
 
1098 
# please don't modify the following
1099 
# variables. They are needed by xf.
1100 
global {autoLoadList}
1101 
set {autoLoadList(testit)} {0}
1102 
global {internalAliasList}
1103 
set {internalAliasList} {}
1104 
global {moduleList}
1105 
set {moduleList(testit)} {}
1106 
global {preloadList}
1107 
set {preloadList(xfInternal)} {}
1108 
global {symbolicName}
1109 
set {symbolicName(binutils)} {.frame0.menubutton7}
1110 
set {symbolicName(dialogbox)} {.top2}
1111 
set {symbolicName(editor)} {.top2.entry4}
1112 
set {symbolicName(g++)} {.frame0.menubutton4}
1113 
set {symbolicName(gas)} {.frame0.menubutton6}
1114 
set {symbolicName(gdb)} {.frame0.menubutton5}
1115 
set {symbolicName(host)} {.frame0.menubutton3.m}
1116 
set {symbolicName(hostlist)} {.frame0.menubutton3}
1117 
set {symbolicName(logs)} {.frame0.menubutton10}
1118 
set {symbolicName(misc)} {.frame0.menubutton1}
1119 
set {symbolicName(ok)} {.top2.button7}
1120 
set {symbolicName(results)} {.frame0.menubutton9}
1121 
set {symbolicName(root)} {.}
1122 
set {symbolicName(sum)} {.frame0.menubutton0}
1123 
set {symbolicName(targlist)} {.frame0.menubutton2}
1124 
global {xfWmSetPosition}
1125 
set {xfWmSetPosition} {}
1126 
global {xfWmSetSize}
1127 
set {xfWmSetSize} {}
1128 
global {xfAppDefToplevels}
1129 
set {xfAppDefToplevels} {}
1130 
 
1131 
# display/remove toplevel windows.
1132 
ShowWindow.
1133 
 
1134 
# load default bindings.
1135 
if {[info exists env(XF_BIND_FILE)] &&
1136 
    "[info procs XFShowHelp]" == ""} {
1137 
  source $env(XF_BIND_FILE)
1138 
}
1139 
 
1140 
# parse and apply application defaults.
1141 
XFLocalLoadAppDefs Testit
1142 
XFLocalSetAppDefs
1143 
 
1144 
# end source
1145 
EndSrc
1146 
 
1147 
# eof
1148 
#
1149 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.