diff options
Diffstat (limited to 'contrib/testit')
| -rwxr-xr-x | contrib/testit | 1149 |
1 files changed, 1149 insertions, 0 deletions
diff --git a/contrib/testit b/contrib/testit new file mode 100755 index 0000000..e866aa6 --- /dev/null +++ b/contrib/testit @@ -0,0 +1,1149 @@ +#!/usr/latest/bin/wish -f +# Program: testit +# Tcl version: 7.2 (Tcl/Tk/XF) +# Tk version: 3.5 +# XF version: 2.2 +# + + +# procedure to show window . +proc ShowWindow. {args} {# xf ignore me 7 + + # Window manager configurations + global tkVersion + wm positionfrom . user + wm sizefrom . "" + wm maxsize . 1152 900 + wm title . {xf} + + # bindings + bind . <Button-3> {MenuPopupPost .frame0.menubutton3.m.menu4 %X %Y} + bind . <ButtonRelease-3> {MenuPopupRelease .frame0.menubutton3.m.menu4 %W} + + # build widget .frame0 + frame .frame0 \ + -background {white} \ + -borderwidth {2} \ + -relief {raised} + + # build widget .frame0.menubutton0 + menubutton .frame0.menubutton0 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton0.m} \ + -text {Summaries} + + # build widget .frame0.menubutton0.m + menu .frame0.menubutton0.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gcc.sum + +} \ + -label {Gcc} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/g++.sum + +} \ + -label {G++} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gdb.sum + +} \ + -label {Gdb} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gas.sum + +} \ + -label {Gas} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/binutils.sum + +} \ + -label {Binutils} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/runtest.sum + +} \ + -label {Runtest} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/tcl.sum + +} \ + -label {Tcl} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/expect.sum + +} \ + -label {Expect} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libg++.sum + +} \ + -label {Libg++} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libio.sum + +} \ + -label {Libio} + .frame0.menubutton0.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libm.sum + +} \ + -label {Libm} + + # build widget .frame0.menubutton1 + menubutton .frame0.menubutton1 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton1.m} \ + -text {Misc} + + # build widget .frame0.menubutton1.m + menu .frame0.menubutton1.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton1.m add command \ + -command {EndSrc +destroy .} \ + -label {Exit} + .frame0.menubutton1.m add command \ + -command {.frame6.frame.text2 delete 0.0 end} \ + -label {Clear window} + .frame0.menubutton1.m add command \ + -command {dialogbox} \ + -label {Editor} + .frame0.menubutton1.m add command \ + -command {.frame6.frame.text2 insert 0.0 "Top of tree is $testbase\n"} \ + -label {Show filename} + + # build widget .frame0.menubutton3 + menubutton .frame0.menubutton3 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton3.m} \ + -text {Host} + + # build widget .frame0.menubutton3.m + menu .frame0.menubutton3.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton3.m add command \ + -command {set host "alpha-dec-osf1.3"} \ + -label {alpha-dec-osf1.3} + .frame0.menubutton3.m add command \ + -command {set host "hppa1.1-hp-hpux"} \ + -label {hppa1.1-hp-hpux} + .frame0.menubutton3.m add command \ + -command {set host "i386-unknown-sysv4.2"} \ + -label {i386-unknown-sysv4.2} + .frame0.menubutton3.m add command \ + -command {set host "m68k-hp-hpux"} \ + -label {m68k-hp-hpux} + .frame0.menubutton3.m add command \ + -command {set host "m68k-sun-sunos4.1.1"} \ + -label {m68k-sun-sunos4.1.1} + .frame0.menubutton3.m add command \ + -command {set host "mips-dec-ultrix4.2"} \ + -label {mips-dec-ultrix4.2} + .frame0.menubutton3.m add command \ + -command {set host "mips-sgi-irix4.0.5H"} \ + -label {mips-sgi-irix4.0.5H} + .frame0.menubutton3.m add command \ + -command {set host "rs6000-ibm-aix3.2"} \ + -label {rs6000-ibm-aix3.2} + .frame0.menubutton3.m add command \ + -command {set host "sparc-sun-solaris2.3"} \ + -label {sparc-sun-solaris2.3} + .frame0.menubutton3.m add command \ + -command {set host "sparc-sun-sunos4.1.3"} \ + -label {sparc-sun-sunos4.1.3} + + # build widget .frame0.menubutton2 + menubutton .frame0.menubutton2 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton2.m} \ + -text {Target} + + # build widget .frame0.menubutton2.m + menu .frame0.menubutton2.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton2.m add command \ + -command {set target "a29k-amd-udi"} \ + -label {a29k-amd-udi} + .frame0.menubutton2.m add command \ + -command {set target "h8300-hms"} \ + -label {h8300-hms} + .frame0.menubutton2.m add command \ + -command {set target "i386-aout"} \ + -label {i386-aout} + .frame0.menubutton2.m add command \ + -command {set target "i386-lynx"} \ + -label {i386-lynx} + .frame0.menubutton2.m add command \ + -command {set target "i960-intel-nindy"} \ + -label {i960-intel-nindy} + .frame0.menubutton2.m add command \ + -command {set target "i960-vxwork"} \ + -label {i960-vxworks} + .frame0.menubutton2.m add command \ + -command {set target "m68k-aout"} \ + -label {m68k-aout} + .frame0.menubutton2.m add command \ + -command {set target "m68k-coff"} \ + -label {m68k-coff} + .frame0.menubutton2.m add command \ + -command {set target "m68k-lynx"} \ + -label {m68k-lynx} + .frame0.menubutton2.m add command \ + -command {set target "m68k-vxworks"} \ + -label {m68k-vxworks} + .frame0.menubutton2.m add command \ + -command {set target "mips-idt-ecoff"} \ + -label {mips-idt-ecoff} + .frame0.menubutton2.m add command \ + -command {set target "sh-hms"} \ + -label {sh-hms} + .frame0.menubutton2.m add command \ + -command {set target "sparc-aout"} \ + -label {sparc-aout} + .frame0.menubutton2.m add command \ + -command {set target "sparc-sun-sunos4.1.3"} \ + -label {sparc-sun-sunos4.1.3} + .frame0.menubutton2.m add command \ + -command {set target "sparc-vxworks"} \ + -label {sparc-vxworks} + .frame0.menubutton2.m add command \ + -command {set target "sparclite-aout"} \ + -label {sparclite-aout} + .frame0.menubutton2.m add command \ + -command {set target "sparclite-coff"} \ + -label {sparclite-coff} + .frame0.menubutton2.m add command \ + -command {set target "hppa1.1-hp-hpux"} \ + -label {hppa1.1-hp-hpux} + .frame0.menubutton2.m add command \ + -command {set target "i386-unknown-sysv4.2"} \ + -label {i386-unknown-sysv4.2} + .frame0.menubutton2.m add command \ + -command {set target "m68k-hp-hpux"} \ + -label {m68k-hp-hpux} + .frame0.menubutton2.m add command \ + -command {set target "m68k-sun-sunos4.1.1"} \ + -label {m68k-sun-sunos4.1.1} + .frame0.menubutton2.m add command \ + -command {set target "mips-dec-ultrix4.2"} \ + -label {mips-dec-ultrix4.2} + .frame0.menubutton2.m add command \ + -command {set target "mips-sgi-irix4.0.5H"} \ + -label {mips-sgi-irix4.0.5H} + .frame0.menubutton2.m add command \ + -command {set target "rs6000-ibm-aix3.2"} \ + -label {rs6000-ibm-aix3.2} + .frame0.menubutton2.m add command \ + -command {set target "sparc-sun-solaris2.3"} \ + -label {sparc-sun-solaris2.3} + + # build widget .frame0.menubutton9 + menubutton .frame0.menubutton9 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton9.m} \ + -text {Results} + + # build widget .frame0.menubutton9.m + menu .frame0.menubutton9.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/gcc + +} \ + -label {Gcc} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/g++ + +} \ + -label {G++} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/gdb + +} \ + -label {Gdb} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/gas + +} \ + -label {Gas} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/binutils + +} \ + -label {Binutils} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/runtest +} \ + -label {Runtest} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/tcl + +} \ + -label {Tcl} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/expect + +} \ + -label {Expect} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/libg++ + +} \ + -label {Libg++} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/libio +} \ + -label {Libio} + .frame0.menubutton9.m add command \ + -command {getresult $testbase/objdir/$host/$target/logs/libm + +} \ + -label {Libm} + + # build widget .frame0.menubutton10 + menubutton .frame0.menubutton10 \ + -background {white} \ + -foreground {black} \ + -menu {.frame0.menubutton10.m} \ + -text {Logs} + + # build widget .frame0.menubutton10.m + menu .frame0.menubutton10.m \ + -background {white} \ + -foreground {black} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gcc.log + +} \ + -label {Gcc} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/g++.log + +} \ + -label {G++} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gdb.log + +} \ + -label {Gdb} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/gas.log + +} \ + -label {Gas} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/binutils.log + +} \ + -label {Binutils} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/runtest.log + +} \ + -label {Runtest} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/tcl.log + +} \ + -label {Tcl} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/expect.log + +} \ + -label {Expect} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libg++.log + +} \ + -label {Libg++} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libio.log + +} \ + -label {Libio} + .frame0.menubutton10.m add command \ + -command {loadfile $testbase/objdir/$host/$target/logs/libm.log + +} \ + -label {Libm} + + # pack widget .frame0 + pack append .frame0 \ + .frame0.menubutton0 {left frame center} \ + .frame0.menubutton1 {right frame center} \ + .frame0.menubutton3 {left frame center} \ + .frame0.menubutton2 {left frame center} \ + .frame0.menubutton9 {left frame center} \ + .frame0.menubutton10 {left frame center} + + # build widget .frame1 + frame .frame1 \ + -background {white} \ + -borderwidth {2} \ + -relief {raised} + + # build widget .frame1.message3 + message .frame1.message3 \ + -aspect {1500} \ + -background {white} \ + -borderwidth {0} \ + -foreground {black} \ + -padx {5} \ + -pady {2} \ + -relief {raised} \ + -text {sparc-sun-sunos4.1.3} \ + -textvariable {host} + + # build widget .frame1.message4 + message .frame1.message4 \ + -aspect {1500} \ + -background {white} \ + -borderwidth {0} \ + -foreground {black} \ + -padx {5} \ + -pady {2} \ + -relief {raised} \ + -text {sparc-sun-sunos4.1.3} \ + -textvariable {target} + + # pack widget .frame1 + pack append .frame1 \ + .frame1.message3 {left frame center} \ + .frame1.message4 {right frame center} + + # build widget .frame6 + frame .frame6 \ + -background {white} \ + -borderwidth {2} \ + -relief {raised} + + # build widget .frame6.frame + frame .frame6.frame \ + -background {white} \ + -relief {raised} + + # build widget .frame6.frame.scrollbar1 + scrollbar .frame6.frame.scrollbar1 \ + -background {white} \ + -command {.frame6.frame.text2 yview} \ + -foreground {black} \ + -relief {raised} + + # build widget .frame6.frame.text2 + text .frame6.frame.text2 \ + -background {white} \ + -borderwidth {2} \ + -foreground {black} \ + -relief {raised} \ + -wrap {word} \ + -yscrollcommand {.frame6.frame.scrollbar1 set} + + # pack widget .frame6.frame + pack append .frame6.frame \ + .frame6.frame.scrollbar1 {left frame center filly} \ + .frame6.frame.text2 {top frame center expand fill} + + # pack widget .frame6 + pack append .frame6 \ + .frame6.frame {top frame center fill} + + # pack widget . + pack append . \ + .frame0 {top frame center fillx} \ + .frame1 {bottom frame center fillx} \ + .frame6 {top frame center expand fill} + + .frame6.frame.text2 insert end {} + + + + if {"[info procs XFEdit]" != ""} { + catch "XFMiscBindWidgetTree ." + after 2 "catch {XFEditSetShowWindows}" + } +} + + +# Procedure: Alias +if {"[info procs Alias]" == ""} { +proc Alias { args} { +# xf ignore me 7 +########## +# Procedure: Alias +# Description: establish an alias for a procedure +# Arguments: args - no argument means that a list of all aliases +# is returned. Otherwise the first parameter is +# the alias name, and the second parameter is +# the procedure that is aliased. +# Returns: nothing, the command that is bound to the alias or a +# list of all aliases - command pairs. +# Sideeffects: internalAliasList is updated, and the alias +# proc is inserted +########## + global internalAliasList + + if {[llength $args] == 0} { + return $internalAliasList + } { + if {[llength $args] == 1} { + set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"] + if {$xfTmpIndex != -1} { + return [lindex [lindex $internalAliasList $xfTmpIndex] 1] + } + } { + if {[llength $args] == 2} { + eval "proc [lindex $args 0] {args} {#xf ignore me 4 +return \[eval \"[lindex $args 1] \$args\"\]}" + set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"] + if {$xfTmpIndex != -1} { + set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"] + } { + lappend internalAliasList "[lindex $args 0] [lindex $args 1]" + } + } { + error "Alias: wrong number or args: $args" + } + } + } +} +} + + +# Procedure: GetSelection +if {"[info procs GetSelection]" == ""} { +proc GetSelection {} { +# xf ignore me 7 +########## +# Procedure: GetSelection +# Description: get current selection +# Arguments: none +# Returns: none +# Sideeffects: none +########## + + # the save way + set xfSelection "" + catch "selection get" xfSelection + if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} { + return "" + } { + return $xfSelection + } +} +} + + +# Procedure: MenuPopupAdd +if {"[info procs MenuPopupAdd]" == ""} { +proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} { +# xf ignore me 7 +# the popup menu handling is from (I already gave up with popup handling :-): +# +# Copyright 1991,1992 by James Noble. +# Everyone is granted permission to copy, modify and redistribute. +# This notice must be preserved on all copies or derivates. +# +########## +# Procedure: MenuPopupAdd +# Description: attach a popup menu to widget +# Arguments: xfW - the widget +# xfButton - the button we use +# xfMenu - the menu to attach +# {xfModifier} - a optional modifier +# {xfCanvasTag} - a canvas tagOrId +# Returns: none +# Sideeffects: none +########## + global tk_popupPriv + + set tk_popupPriv($xfMenu,focus) "" + set tk_popupPriv($xfMenu,grab) "" + if {"$xfModifier" != ""} { + set press "$xfModifier-" + set motion "$xfModifier-" + set release "Any-" + } { + set press "" + set motion "" + set release "" + } + + bind $xfMenu "<${motion}B${xfButton}-Motion>" "MenuPopupMotion $xfMenu %W %X %Y" + bind $xfMenu "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W" + if {"$xfCanvasTag" == ""} { + bind $xfW "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y" + bind $xfW "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W" + } { + $xfW bind $xfCanvasTag "<${press}ButtonPress-${xfButton}>" "MenuPopupPost $xfMenu %X %Y" + $xfW bind $xfCanvasTag "<${release}ButtonRelease-${xfButton}>" "MenuPopupRelease $xfMenu %W" + } +} +} + + +# Procedure: MenuPopupMotion +if {"[info procs MenuPopupMotion]" == ""} { +proc MenuPopupMotion { xfMenu xfW xfX xfY} { +# xf ignore me 7 +########## +# Procedure: MenuPopupMotion +# Description: handle the popup menu motion +# Arguments: xfMenu - the topmost menu +# xfW - the menu +# xfX - the root x coordinate +# xfY - the root x coordinate +# Returns: none +# Sideeffects: none +########## + global tk_popupPriv + + if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] && + "[winfo class $xfW]" == "Menu" && + [info exists tk_popupPriv($xfMenu,focus)] && + "$tk_popupPriv($xfMenu,focus)" != "" && + [info exists tk_popupPriv($xfMenu,grab)] && + "$tk_popupPriv($xfMenu,grab)" != ""} { + set xfPopMinX [winfo rootx $xfW] + set xfPopMaxX [expr $xfPopMinX+[winfo width $xfW]] + if {$xfX >= $xfPopMinX && $xfX <= $xfPopMaxX} { + $xfW activate @[expr $xfY-[winfo rooty $xfW]] + if {![catch "$xfW entryconfig @[expr $xfY-[winfo rooty $xfW]] -menu" result]} { + if {"[lindex $result 4]" != ""} { + foreach binding [bind $xfMenu] { + bind [lindex $result 4] $binding [bind $xfMenu $binding] + } + } + } + } { + $xfW activate none + } + } +} +} + + +# Procedure: MenuPopupPost +if {"[info procs MenuPopupPost]" == ""} { +proc MenuPopupPost { xfMenu xfX xfY} { +# xf ignore me 7 +########## +# Procedure: MenuPopupPost +# Description: post the popup menu +# Arguments: xfMenu - the menu +# xfX - the root x coordinate +# xfY - the root x coordinate +# Returns: none +# Sideeffects: none +########## + global tk_popupPriv + + if {"[info commands $xfMenu]" != ""} { + if {![info exists tk_popupPriv($xfMenu,focus)]} { + set tk_popupPriv($xfMenu,focus) [focus] + } { + if {"$tk_popupPriv($xfMenu,focus)" == ""} { + set tk_popupPriv($xfMenu,focus) [focus] + } + } + set tk_popupPriv($xfMenu,grab) $xfMenu + + catch "$xfMenu activate none" + catch "$xfMenu post $xfX $xfY" + catch "focus $xfMenu" + catch "grab -global $xfMenu" + } +} +} + + +# Procedure: MenuPopupRelease +if {"[info procs MenuPopupRelease]" == ""} { +proc MenuPopupRelease { xfMenu xfW} { +# xf ignore me 7 +########## +# Procedure: MenuPopupRelease +# Description: remove the popup menu +# Arguments: xfMenu - the topmost menu widget +# xfW - the menu widget +# Returns: none +# Sideeffects: none +########## + global tk_popupPriv + global tkVersion + + if {"[info commands $xfW]" != "" && [winfo ismapped $xfW] && + "[winfo class $xfW]" == "Menu" && + [info exists tk_popupPriv($xfMenu,focus)] && + "$tk_popupPriv($xfMenu,focus)" != "" && + [info exists tk_popupPriv($xfMenu,grab)] && + "$tk_popupPriv($xfMenu,grab)" != ""} { + if {$tkVersion >= 3.0} { + catch "grab release $tk_popupPriv($xfMenu,grab)" + } { + catch "grab none" + } + catch "focus $tk_popupPriv($xfMenu,focus)" + set tk_popupPriv($xfMenu,focus) "" + set tk_popupPriv($xfMenu,grab) "" + if {"[$xfW index active]" != "none"} { + $xfW invoke active; catch "$xfMenu unpost" + } + } + catch "$xfMenu unpost" +} +} + + +# Procedure: NoFunction +if {"[info procs NoFunction]" == ""} { +proc NoFunction { args} { +# xf ignore me 7 +########## +# Procedure: NoFunction +# Description: do nothing (especially with scales and scrollbars) +# Arguments: args - a number of ignored parameters +# Returns: none +# Sideeffects: none +########## +} +} + + +# Procedure: SN +if {"[info procs SN]" == ""} { +proc SN { {xfName ""}} { +# xf ignore me 7 +########## +# Procedure: SN +# Description: map a symbolic name to the widget path +# Arguments: xfName +# Returns: the symbolic name +# Sideeffects: none +########## + + SymbolicName $xfName +} +} + + +# Procedure: SymbolicName +if {"[info procs SymbolicName]" == ""} { +proc SymbolicName { {xfName ""}} { +# xf ignore me 7 +########## +# Procedure: SymbolicName +# Description: map a symbolic name to the widget path +# Arguments: xfName +# Returns: the symbolic name +# Sideeffects: none +########## + + global symbolicName + + if {"$xfName" != ""} { + set xfArrayName "" + append xfArrayName symbolicName ( $xfName ) + if {![catch "set \"$xfArrayName\"" xfValue]} { + return $xfValue + } { + if {"[info commands XFProcError]" != ""} { + XFProcError "Unknown symbolic name:\n$xfName" + } { + puts stderr "XF error: unknown symbolic name:\n$xfName" + } + } + } + return "" +} +} + + +# Procedure: Unalias +if {"[info procs Unalias]" == ""} { +proc Unalias { aliasName} { +# xf ignore me 7 +########## +# Procedure: Unalias +# Description: remove an alias for a procedure +# Arguments: aliasName - the alias name to remove +# Returns: none +# Sideeffects: internalAliasList is updated, and the alias +# proc is removed +########## + global internalAliasList + + set xfIndex [lsearch $internalAliasList "$aliasName *"] + if {$xfIndex != -1} { + rename $aliasName "" + set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex] + } +} +} + + +# Procedure: getbase +proc getbase {} { + global env + global testbase + if [info exists env(TESTBASE)] then { + set testbase $env(TESTBASE) + } else { + set testbase /lisa/test/rob + } + return $testbase +} + + +# Procedure: getresult +proc getresult { name} { +set tmp "[lsort [glob -nocomplain $name-results-??????-????]]" +set tmp [lindex $tmp [expr [llength $tmp] - 1]] +if [string match "" $tmp] then { + .frame6.frame.text2 delete 0.0 end + .frame6.frame.text2 insert 0.0 "Couldn't find results for: $name\n" + return +} else { + return [loadfile $tmp] +} +} + +# Procedure: dialogbox +proc dialogbox {} { + set w .frame6.top2 + catch {destroy $w} + catch {destroy $w.e1} + toplevel $w +# dpos $w + wm title $w "Change Editor" + wm iconname $w "Entries" + message $w.msg -font -Adobe-times-medium-r-normal--*-180* -aspect 200 \ + -text "Hey Now. Click the \"OK\" button when you've seen enough." + frame $w.frame -borderwidth 10 + button $w.ok -text OK -command "destroy $w" + pack $w.msg $w.frame $w.ok -side top -fill both + + entry $w.frame.e1 -relief sunken -textvariable editor + pack $w.frame.e1 -side top -pady 5 -fill x + bind $w.frame.e1 <Return> "destroy $w" +} + +# Procedure: loadfile +proc loadfile { name} { +if ![file exists $name] then { + .frame6.frame.text2 delete 0.0 end + .frame6.frame.text2 insert 0.0 "Couldn't find:\t$name\n" + return +} + +global editor +if [info exists editor] then { + if ![string match "" $editor] then { + catch "exec $editor $name&" tmp + if [info exists tmp] then { + .frame6.frame.text2 delete 0.0 end + .frame6.frame.text2 insert 0.0 "Editor returned $tmp\n" + } + } +} +.frame6.frame.text2 delete 0.0 end +set fd [open $name r] +while { [gets $fd line]>=0 } { +.frame6.frame.text2 insert end "$line\n" +.frame6.frame.text2 mark set insert 0.0 +} +close $fd +unset fd +} + + + +# application parsing procedure +proc XFLocalParseAppDefs {xfAppDefFile} { + global xfAppDefaults + + # basically from: Michael Moore + if {[file exists $xfAppDefFile] && + [file readable $xfAppDefFile] && + "[file type $xfAppDefFile]" == "link"} { + catch "file type $xfAppDefFile" xfType + while {"$xfType" == "link"} { + if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} { + return + } + catch "file type $xfAppDefFile" xfType + } + } + if {!("$xfAppDefFile" != "" && + [file exists $xfAppDefFile] && + [file readable $xfAppDefFile] && + "[file type $xfAppDefFile]" == "file")} { + return + } + if {![catch "open $xfAppDefFile r" xfResult]} { + set xfAppFileContents [read $xfResult] + close $xfResult + foreach line [split $xfAppFileContents "\n"] { + # backup indicates how far to backup. It applies to the + # situation where a resource name ends in . and when it + # ends in *. In the second case you want to keep the * + # in the widget name for pattern matching, but you want + # to get rid of the . if it is the end of the name. + set backup -2 + set line [string trim $line] + if {[string index $line 0] == "#" || "$line" == ""} { + # skip comments and empty lines + continue + } + set list [split $line ":"] + set resource [string trim [lindex $list 0]] + set i [string last "." $resource] + set j [string last "*" $resource] + if {$j > $i} { + set i $j + set backup -1 + } + incr i + set name [string range $resource $i end] + incr i $backup + set widname [string range $resource 0 $i] + set value [string trim [lindex $list 1]] + if {"$widname" != "" && "$widname" != "*"} { + # insert the widget and resourcename to the application + # defaults list. + if {![info exists xfAppDefaults]} { + set xfAppDefaults "" + } + lappend xfAppDefaults [list $widname [string tolower $name] $value] + } + } + } +} + +# application loading procedure +proc XFLocalLoadAppDefs {{xfClasses ""} {xfPriority "startupFile"} {xfAppDefFile ""}} { + global env + + if {"$xfAppDefFile" == ""} { + set xfFileList "" + if {[info exists env(XUSERFILESEARCHPATH)]} { + append xfFileList [split $env(XUSERFILESEARCHPATH) :] + } + if {[info exists env(XAPPLRESDIR)]} { + append xfFileList [split $env(XAPPLRESDIR) :] + } + if {[info exists env(XFILESEARCHPATH)]} { + append xfFileList [split $env(XFILESEARCHPATH) :] + } + append xfFileList " /usr/lib/X11/app-defaults" + append xfFileList " /usr/X11/lib/X11/app-defaults" + + foreach xfCounter1 $xfClasses { + foreach xfCounter2 $xfFileList { + set xfPathName $xfCounter2 + if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} { + set xfPathName $xfResult + } + if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} { + set xfPathName $xfResult + } + if {[regsub -all "%S" "$xfPathName" "" xfResult]} { + set xfPathName $xfResult + } + if {[regsub -all "%C" "$xfPathName" "" xfResult]} { + set xfPathName $xfResult + } + if {[file exists $xfPathName] && + [file readable $xfPathName] && + ("[file type $xfPathName]" == "file" || + "[file type $xfPathName]" == "link")} { + catch "option readfile $xfPathName $xfPriority" + if {"[info commands XFParseAppDefs]" != ""} { + XFParseAppDefs $xfPathName + } { + if {"[info commands XFLocalParseAppDefs]" != ""} { + XFLocalParseAppDefs $xfPathName + } + } + } { + if {[file exists $xfCounter2/$xfCounter1] && + [file readable $xfCounter2/$xfCounter1] && + ("[file type $xfCounter2/$xfCounter1]" == "file" || + "[file type $xfCounter2/$xfCounter1]" == "link")} { + catch "option readfile $xfCounter2/$xfCounter1 $xfPriority" + if {"[info commands XFParseAppDefs]" != ""} { + XFParseAppDefs $xfCounter2/$xfCounter1 + } { + if {"[info commands XFLocalParseAppDefs]" != ""} { + XFLocalParseAppDefs $xfCounter2/$xfCounter1 + } + } + } + } + } + } + } { + # load a specific application defaults file + if {[file exists $xfAppDefFile] && + [file readable $xfAppDefFile] && + ("[file type $xfAppDefFile]" == "file" || + "[file type $xfAppDefFile]" == "link")} { + catch "option readfile $xfAppDefFile $xfPriority" + if {"[info commands XFParseAppDefs]" != ""} { + XFParseAppDefs $xfAppDefFile + } { + if {"[info commands XFLocalParseAppDefs]" != ""} { + XFLocalParseAppDefs $xfAppDefFile + } + } + } + } +} + +# application setting procedure +proc XFLocalSetAppDefs {{xfWidgetPath "."}} { + global xfAppDefaults + + if {![info exists xfAppDefaults]} { + return + } + foreach xfCounter $xfAppDefaults { + if {"$xfCounter" == ""} { + break + } + set widname [lindex $xfCounter 0] + if {[string match $widname ${xfWidgetPath}] || + [string match "${xfWidgetPath}*" $widname]} { + set name [string tolower [lindex $xfCounter 1]] + set value [lindex $xfCounter 2] + # Now lets see how many tcl commands match the name + # pattern specified. + set widlist [info command $widname] + if {"$widlist" != ""} { + foreach widget $widlist { + # make sure this command is a widget. + if {![catch "winfo id $widget"] && + [string match "${xfWidgetPath}*" $widget]} { + catch "$widget configure -$name $value" + } + } + } + } + } +} + + + +# startup source +proc StartupSrc {args} { +global testbase +global hostlist +global targlist +global host + +set host [exec config.guess] +set target $host +} + + +# end source +proc EndSrc {} { +.frame6.frame.text2 delete 0.0 end +} + +# startup source +StartupSrc + +# initialize global variables +global {editor} +set {editor} {} +global {fsBox} +set {fsBox(activeBackground)} {} +set {fsBox(activeForeground)} {} +set {fsBox(all)} {0} +set {fsBox(background)} {} +set {fsBox(button)} {0} +set {fsBox(extensions)} {0} +set {fsBox(font)} {} +set {fsBox(foreground)} {} +set {fsBox(internalPath)} {/offsite/rob/DejaGnu/devo/dejagnu} +set {fsBox(name)} {} +set {fsBox(path)} {/offsite/rob/DejaGnu/devo/dejagnu} +set {fsBox(pattern)} {*} +set {fsBox(scrollActiveForeground)} {} +set {fsBox(scrollBackground)} {} +set {fsBox(scrollForeground)} {} +set {fsBox(scrollSide)} {left} +set {fsBox(showPixmap)} {0} +global {host} +set {host} {sparc-sun-sunos4.1.3} +global {result} +set {result} {can't read "editor": no such variable} +global {target} +set {target} {sparc-sun-sunos4.1.3} +global {testbase} +set {testbase} {/lisa/test/rob} + +# please don't modify the following +# variables. They are needed by xf. +global {autoLoadList} +set {autoLoadList(testit)} {0} +global {internalAliasList} +set {internalAliasList} {} +global {moduleList} +set {moduleList(testit)} {} +global {preloadList} +set {preloadList(xfInternal)} {} +global {symbolicName} +set {symbolicName(binutils)} {.frame0.menubutton7} +set {symbolicName(dialogbox)} {.top2} +set {symbolicName(editor)} {.top2.entry4} +set {symbolicName(g++)} {.frame0.menubutton4} +set {symbolicName(gas)} {.frame0.menubutton6} +set {symbolicName(gdb)} {.frame0.menubutton5} +set {symbolicName(host)} {.frame0.menubutton3.m} +set {symbolicName(hostlist)} {.frame0.menubutton3} +set {symbolicName(logs)} {.frame0.menubutton10} +set {symbolicName(misc)} {.frame0.menubutton1} +set {symbolicName(ok)} {.top2.button7} +set {symbolicName(results)} {.frame0.menubutton9} +set {symbolicName(root)} {.} +set {symbolicName(sum)} {.frame0.menubutton0} +set {symbolicName(targlist)} {.frame0.menubutton2} +global {xfWmSetPosition} +set {xfWmSetPosition} {} +global {xfWmSetSize} +set {xfWmSetSize} {} +global {xfAppDefToplevels} +set {xfAppDefToplevels} {} + +# display/remove toplevel windows. +ShowWindow. + +# load default bindings. +if {[info exists env(XF_BIND_FILE)] && + "[info procs XFShowHelp]" == ""} { + source $env(XF_BIND_FILE) +} + +# parse and apply application defaults. +XFLocalLoadAppDefs Testit +XFLocalSetAppDefs + +# end source +EndSrc + +# eof +# + |