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