Subversion Repositories or1k_old

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