dejagnu/contrib/testit

   1 #!/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 . <Button-3> {MenuPopupPost .frame0.menubutton3.m.menu4 %X %Y}
  21   bind . <ButtonRelease-3> {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 <Return> "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