#         Portable Batch System (PBS) Software License
# 
# Copyright (c) 1999, MRJ Technology Solutions.
# All rights reserved.
# 
# Acknowledgment: The Portable Batch System Software was originally developed
# as a joint project between the Numerical Aerospace Simulation (NAS) Systems
# Division of NASA Ames Research Center and the National Energy Research
# Supercomputer Center (NERSC) of Lawrence Livermore National Laboratory.
# 
# Redistribution of the Portable Batch System Software and use in source
# and binary forms, with or without modification, are permitted provided
# that the following conditions are met:
# 
# - Redistributions of source code must retain the above copyright and
#   acknowledgment notices, this list of conditions and the following
#   disclaimer.
# 
# - Redistributions in binary form must reproduce the above copyright and 
#   acknowledgment notices, this list of conditions and the following
#   disclaimer in the documentation and/or other materials provided with the
#   distribution.
# 
# - All advertising materials mentioning features or use of this software must
#   display the following acknowledgment:
# 
#   This product includes software developed by NASA Ames Research Center,
#   Lawrence Livermore National Laboratory, and MRJ Technology Solutions.
# 
#         DISCLAIMER OF WARRANTY
# 
# THIS SOFTWARE IS PROVIDED BY MRJ TECHNOLOGY SOLUTIONS ("MRJ") "AS IS" WITHOUT 
# WARRANTY OF ANY KIND, AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT ARE EXPRESSLY DISCLAIMED.
# 
# IN NO EVENT, UNLESS REQUIRED BY APPLICABLE LAW, SHALL MRJ, NASA, NOR
# THE U.S. GOVERNMENT BE LIABLE FOR ANY DIRECT DAMAGES WHATSOEVER,
# NOR ANY INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
# USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# This license will be governed by the laws of the Commonwealth of Virginia,
# without reference to its choice of law rules.

# listcomp: Returns 0 if the 2 lists are the same (order of elements will not
# matter); otherwise 1.
proc listcomp {list1 list2} {
  if {[llength $list1] != [llength $list2]} {
        return 1
  }

  foreach e1 $list1 {
        set j 0
        foreach e2 $list2 {  
                if {[string compare $e1 $e2] == 0} {
                        set list2 [lreplace $list2 $j $j]
                        break
                }
                incr j
        }
  }
  if {[llength $list2] != 0} {
        return 1
  }
  return 0
}

# busy_cursor: displays a busy cursor under the mouse pointer position over a
#              "registered" active window.
proc busy_cursor {} {
  global activeWindow bitmap_dir

  foreach win [array names activeWindow] {
    if {$activeWindow($win)} {
      $win configure -cursor "@$bitmap_dir/hourglass.bmp black"
    }
  }
}

# remove_busy_cursor: removes the busy cursor set up by busy_cursor.
proc remove_busy_cursor {} {
  global activeWindow

  foreach win [array names activeWindow] {
    if {$activeWindow($win)} {
      $win configure -cursor {}
    }
  }
}

# InfoBox_sendmsg: The following procedure sends the specified 'message' to
#	Info Box.
# OPTIONS:
#       'line_number' - the position on the InfoBox where the message will be
#			placed.
#       'append'      - to append messages to an existing entry.
#       'xview_increment' - how much to right shift the horizontal display of
#			    the InfoBox.
proc InfoBox_sendmsg { message {line_number 1} {append 0} \
      {xview_increment 1} } {
     global sysinfo tk_version

    if {![info exists sysinfo(infoBox)]} {
	return
    }
	
    if {[string compare $line_number "end"] == 0} {
		set line_number [$sysinfo(infoBox) size]
    }

     catch {exec date "+%D %T"} datestr
     if {!$append} {
       set msg "\[$datestr\] $message"
       set sysinfo(infoBoxCounter) \
		[expr [string length $msg] - $sysinfo(infoListBoxWidth)]
       catch {$sysinfo(infoBox) insert $line_number $msg}

       set lsize [$sysinfo(infoBox) size]
       set line_to_delete [expr $line_number + 1]
       if { $lsize > 1 && $line_to_delete < $lsize } {
         catch {$sysinfo(infoBox) delete $line_to_delete}
       }
     } else {
       set cval [$sysinfo(infoBox) get $line_number]
       incr sysinfo(infoBoxCounter) $xview_increment
       catch {$sysinfo(infoBox) insert $line_number "$cval$message"} out

       set lsize [$sysinfo(infoBox) size]
       set line_to_delete [expr $line_number + 1]
       if { $lsize > 1 && $line_to_delete < $lsize } {
         catch {$sysinfo(infoBox) delete $line_to_delete}
       }
     }
     if {$tk_version >= 4.0} {
        if {$sysinfo(infoBoxCounter) > 0} {
          $sysinfo(infoBox) xview moveto 1
        } else {
          $sysinfo(infoBox) xview 0
        }
     } else {
        $sysinfo(infoBox) xview $sysinfo(infoBoxCounter)
     }
     update idletasks
}

proc InfoBox_flush {start_line} {
	global sysinfo

	$sysinfo(infoBox) delete $start_line end
}

# digit: returns the integer given some number string (like atoi). Tcl seems to
#       be having problems converting from 08/09 to 8/9 so this procedure is
#	needed.
proc digit {number_str} {
  switch -regexp -- $number_str {
  "^(00|01|02|03|04|05|06|07|08|09)$"  {return [string index $number_str 1]}
  default                              {return $number_str}
  }
}

proc stackPush {element} {
        global sysinfo

        if [info exists sysinfo(stack)] {
                set newstack [linsert $sysinfo(stack) 0 $element]
                set sysinfo(stack) $newstack
        } else {
                set sysinfo(stack) $element
        }
}

proc stackPop {} {
        global sysinfo

        set sysinfo(stack) [lrange $sysinfo(stack) 1 end]
}

proc isStackEmpty {} {
        global sysinfo

        if { ![info exists sysinfo(stack)] || \
             [llength $sysinfo(stack)] == 0 } {
                return 1
        }
        return 0
}
proc stackClear {} {
        global sysinfo

        set sysinfo(stack) {}
}

proc stackPrint {} {
        global sysinfo

        if [info exists sysinfo(stack)] {
                puts "STACK entries: $sysinfo(stack)"
        } else {
                puts "STACK entries: "
        }
}


proc addLlist {llist key row col} {

        upvar $llist ll
        set append 1
        set newll ""
        foreach elem $ll {
                set mid [lsearch -exact $elem $key]

                if {$mid != -1} { # found a match
                        set newelem [concat $elem $row $col]
                        lappend newll $newelem
                        set append 0
                } else {
                        lappend newll $elem
                }
        }
        if {$append} {
                lappend newll "$key $row $col"
        }
        set ll $newll
        return $append
}

proc cleanstr {str} {
        global sysinfo

        set newstr ""
        for {set i 0} {$i < [string length $str]} {incr i} {
                set c [string index $str $i]
                if { [string compare $c \
                                $sysinfo(rcSiteInfoDelimeterChar)] != 0 && \
		     [string compare $c "\["] != 0 && \
		     [string compare $c "\]"] != 0 } {
                        set newstr "$newstr$c"
                }
        }
        return $newstr
}
