#!/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
#