torque-client-x11 2.4.16+dfsg-1build1 / usr / lib / xpbsmon / listbox.tk

#         OpenPBS (Portable Batch System) v2.3 Software License
# 
# Copyright (c) 1999-2000 Veridian Information Solutions, Inc.
# All rights reserved.
# 
# ---------------------------------------------------------------------------
# For a license to use or redistribute the OpenPBS software under conditions
# other than those described below, or to purchase support for this software,
# please contact Veridian Systems, PBS Products Department ("Licensor") at:
# 
#    www.OpenPBS.org  +1 650 967-4675                  sales@OpenPBS.org
#                        877 902-4PBS (US toll-free)
# ---------------------------------------------------------------------------
# 
# This license covers use of the OpenPBS v2.3 software (the "Software") at
# your site or location, and, for certain users, redistribution of the
# Software to other sites and locations.  Use and redistribution of
# OpenPBS v2.3 in source and binary forms, with or without modification,
# are permitted provided that all of the following conditions are met.
# After December 31, 2001, only conditions 3-6 must be met:
# 
# 1. Commercial and/or non-commercial use of the Software is permitted
#    provided a current software registration is on file at www.OpenPBS.org.
#    If use of this software contributes to a publication, product, or
#    service, proper attribution must be given; see www.OpenPBS.org/credit.html
# 
# 2. Redistribution in any form is only permitted for non-commercial,
#    non-profit purposes.  There can be no charge for the Software or any
#    software incorporating the Software.  Further, there can be no
#    expectation of revenue generated as a consequence of redistributing
#    the Software.
# 
# 3. Any Redistribution of source code must retain the above copyright notice
#    and the acknowledgment contained in paragraph 6, this list of conditions
#    and the disclaimer contained in paragraph 7.
# 
# 4. Any Redistribution in binary form must reproduce the above copyright
#    notice and the acknowledgment contained in paragraph 6, this list of
#    conditions and the disclaimer contained in paragraph 7 in the
#    documentation and/or other materials provided with the distribution.
# 
# 5. Redistributions in any form must be accompanied by information on how to
#    obtain complete source code for the OpenPBS software and any
#    modifications and/or additions to the OpenPBS software.  The source code
#    must either be included in the distribution or be available for no more
#    than the cost of distribution plus a nominal fee, and all modifications
#    and additions to the Software must be freely redistributable by any party
#    (including Licensor) without restriction.
# 
# 6. All advertising materials mentioning features or use of the Software must
#    display the following acknowledgment:
# 
#     "This product includes software developed by NASA Ames Research Center,
#     Lawrence Livermore National Laboratory, and Veridian Information
#     Solutions, Inc.
#     Visit www.OpenPBS.org for OpenPBS software support,
#     products, and information."
# 
# 7. DISCLAIMER OF WARRANTY
# 
# THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. 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 SHALL VERIDIAN CORPORATION, ITS AFFILIATED COMPANIES, OR THE
# U.S. GOVERNMENT OR ANY OF ITS AGENCIES BE LIABLE FOR ANY DIRECT OR 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.
################################################################################
# This file contains all procedures related to listboxes.
# In PBS's GUI:
#	a listbox can have 
#		one or more entries, 
#	and each entry is made up of a
#		number of field values separated by one or more white spaces. 
#       A field is referred to as 
#		the index # representing the corresponding field value.
# The terms "entry", "field", "fieldval" will be used to represent listbox
# elements.
#
################################################################################
# buildFullListbox: a procedure that automates the creation of a complete
# listbox using the "listbox" widet command.
# INPUT: frame_name          - the name of the frame widget where to place the
#				complete listbox.
#        ColxRow             - # of columns (characters) and # of rows
#				lines on the the listbox. Must have the
#				format, <number>x<number>  
#	  header_str          - the header string of the listbox.
# 	  scrollbarType       - specifies the orientation of the listbox's
#			        scrollbar. Can only have the values:
#				xscroll, yscroll, xyscroll, noscroll.
# IF header_str is the empty "" string, then the listbox will have no header
# meaning, even the select all/deselect all button will not be placed.
# 	
# OPTIONS:
#	all_button		- if you want the "Select All/Deselect All" to
#				  be included. 
#	header_at_left		- if you want the header string to be at the
#				  left side of the listbox.
proc buildFullListbox {frame_name ColxRow header_str scrollbarType \
		{all_button 1} {header_at_left 0} {expand_label 1}} {

  global BADPARAM errmsg tk_version canvas
  set procname "buildFull_FullListbox"

  set scrollbars ""

## Let's be defensive about the input
  if { ![regexp "\\." $frame_name] || \
        ![regexp "(\[0-9]+)x(\[0-9]+)" $ColxRow match Col Row] || \
        ([string compare $scrollbarType  "xscroll"] != 0 &&  \
         [string compare $scrollbarType  "yscroll"] != 0 &&  \
         [string compare $scrollbarType  "xyscroll"] != 0 && \
	 [string compare $scrollbarType  "noscroll"] != 0) } {
        puts "Error $BADPARAM in $procname: $errmsg(BADPARAM)"
	exit $BADPARAM
  }
  if { [string compare $frame_name "." ] == 0 } {
	set frame_name ""
  }

  if { [string compare $header_str ""] != 0 } {
    frame $frame_name.header -borderwidth 1

    pack  $frame_name.header -side top -expand 1

    label $frame_name.header.label  -text $header_str -anchor nw \
					-padx 1 -pady 1

    set labelwidth \
	[expr $canvas(bigLabelFontWidth)*[string length header_str]]
    set listboxwidth [expr $canvas(bigLabelFontWidth)*$Col]
    
    set padx [expr round($listboxwidth*0.4)]
    if {[expr $padx + $labelwidth] > $listboxwidth} {
	set padx 0
    } 

    if {$all_button} {
      set selMode "Select All"
      button $frame_name.header.select \
			-padx 2m  \
			-anchor c -width 12 -text "Select All" -pady 1

      if {$expand_label} {	
      	pack $frame_name.header.label -side left -anchor nw -expand 1 \
		-padx $padx
      } else {
      	pack $frame_name.header.label -side left -anchor nw
      }	
	
      pack $frame_name.header.select -side left -anchor se 
    } else {
      if {$expand_label} {	
        pack $frame_name.header.label -side left -anchor nw -expand 1 \
			-padx $padx
      } else {	
        pack $frame_name.header.label -side left -anchor nw
      }

    }
    if {$header_at_left && [string compare $header_str ""] != 0} {
      $frame_name.header.label configure \
                               -width [string length $header_str] \
			       -padx $padx	
      pack forget $frame_name.header $frame_name.header.label
      pack $frame_name.header $frame_name.header.label -expand 0 -side left \
	   -anchor nw
    }
  }



  listbox $frame_name.box 	-borderwidth 1 \
			        -setgrid 0 \
				-exportselection false \
                                -relief sunken

  if { $tk_version < 4.0 } {
    $frame_name.box configure -geometry $ColxRow
  } else {
    $frame_name.box configure -width $Col -height $Row -selectmode extended
  }

  pack $frame_name.box      -anchor se -side left -expand 1 -fill x

  if { [string compare $scrollbarType "yscroll"] == 0 || \
       [string compare $scrollbarType "xyscroll"] == 0 } {	
       scrollbar $frame_name.vscroll -command "$frame_name.box yview" \
                                     -borderwidth 2 \
                                     -orient vertical \
                                     -relief groove
       $frame_name.box configure -yscrollcommand "$frame_name.vscroll set"  	
       pack $frame_name.vscroll  -anchor w -fill y -expand 1 -side right \
				 -before $frame_name.box

       append scrollbars " $frame_name.vscroll"
  }

  if { [string compare $scrollbarType "xscroll"] == 0 || \
       [string compare $scrollbarType "xyscroll"] == 0 } {	
       scrollbar $frame_name.hscroll -command "$frame_name.box xview" \
                                     -borderwidth 2 \
                                     -orient horizontal \
                                     -relief groove

       $frame_name.box configure -xscrollcommand "$frame_name.hscroll set"
       pack $frame_name.hscroll  -fill x -expand 1 -side bottom \
				 -before $frame_name.box -anchor nw
       append scrollbars " $frame_name.hscroll"
  }

  return [concat $frame_name $frame_name.header.label \
		 $frame_name.header.select $frame_name.box $scrollbars]
}

# get_keyvals: Procedure that returns a formatted string containing field
# values (indexes specified in 'key_list') of a listbox, 'lbox'. The format of
# string puts 'inner_sep' within key values of an entry, and 'outer_sep' 
# between entries of the listbox. The entries of the listbox that will be
# checked can be either "all" or "select".
#
# Ex. suppose you have a listbox, lbox1, whose key is a pair: 
#     {column_0 column_6}.  The idea is to return the string:
#
#	"entry0_key0val@entry0_key6val|entry1_key0val@entry1_key6val}|.."
#     Do this by calling the procedure as follows:
#	   get_keyvals lbox1 {0 6} "@" "|" "all"
#
# CAUTION: This procedure returns a list of elements ACCORDING to its 
# increasing entry position in the list box.
# So returning "elem1 elem2 elem3" means 'elem1' appears in the listbox before
# 'elem2', and 'elem2' appears before 'elem3', and so on. 
proc get_keyvals {lbox key_list inner_sep outer_sep {type "all"}} {

# Get the indices to the entries
  if { [string compare $type "select"] == 0 } {
    set indices [$lbox curselection]
  } else {
    set num_els [$lbox size]

    set indices ""
    for {set i 0} {$i < $num_els} {incr i} {
      append indices " $i"
    }
  }
 
  if {[string compare $indices ""] == 0} {
     return ""	;# No need to proceed if there are no entries
		;# in lbox1 selected.
  }
  set elems ""
  foreach entry [lsort -integer -increasing $indices] {
      set key_elems ""
      set lbox_entry [$lbox get $entry]
      foreach field [lrange $key_list 0 end] {
        append key_elems "[lindex $lbox_entry $field]$inner_sep"
      }

      if { [string compare $key_elems $outer_sep] == 0 } {
	InfoBox_sendmsg "Found \"$lbox_entry\" entry to have incomplete information"
        append elems "$key_elems$outer_sep"
      } else { 
        append elems "[string trim $key_elems $inner_sep]$outer_sep"
      }
  }
  return "[string trim $elems $outer_sep]"
}

# strget_keyvals: similar to get_keyvals except instead of a listbox, the 
# source is a string.
proc strget_keyvals {str key_list sep} {

  if {[string compare $str ""] == 0} {
     return ""	;# No need to proceed if there are no entries
		;# in lbox1 selected.
  }

  set key_elems ""
  foreach field [lrange $key_list 0 end] {
    if {[string compare $key_elems ""] != 0} {
      append key_elems "$sep[lindex $str $field]"
    } else {
      set key_elems [lindex $str $field]
    }
  }

  return $key_elems
}

proc disable_listbox { box headerLabel selButton scrollbar} {
  global sysinfo canvas

  if { [string compare $headerLabel ""] != 0 } {
    disable_label $headerLabel $canvas(disabledColor)
  }
  if { [string compare $selButton ""] != 0 } {
    disable_button $selButton
  }
  if { [string compare $scrollbar ""] != 0 } {
    disable_scrollbar $scrollbar $canvas(disabledColor)
  }
  bind_listbox_readonly $box 

  set fgColor 	 [lindex [$box configure -foreground] 4]
  set selBgColor [lindex [$box configure -selectbackground] 4]
  set selFgColor [lindex [$box configure -selectforeground] 4]

  if { [string compare $canvas(disabledColor) $fgColor] == 0 && \
       [string compare $canvas(disabledColor) $selFgColor] == 0 && \
       [string compare $canvas(disabledColor) $selBgColor] == 0} {
	return
  }

  set sysinfo((selfgColor$box) $fgColor
  set sysinfo(selFgColor$box) $selFgColor
  set sysinfo(selBgColor$box) $selBgColor

  $box configure -foreground $canvas(disabledColor) \
		 -selectforeground $canvas(disabledColor) \
		 -selectbackground $canvas(disabledColor)
}

proc enable_listbox { box headerLabel selButton scrollbar enaBox_proc } {
  global sysinfo

  if { 	![info exists sysinfo(selfgColor$box)] && \
	![info exists sysinfo(selFgColor$box)] && \
	![info exists sysinfo(selBgColor$box)]} {
		return
  }


  if { [string compare $headerLabel ""] != 0 } {
    enable_label $headerLabel
  }

  if { [string compare $selButton ""] != 0 } {
    enable_button $selButton
  }
  if { [string compare $scrollbar ""] != 0 } {
    enable_scrollbar $scrollbar
  }

  eval $enaBox_proc $box

  $box configure -foreground $sysinfo(selfgColor$box) \
		 -selectforeground $sysinfo(selFgColor$box) \
		 -selectbackground $sysinfo(selBgColor$box)
}

proc lboxvalue_isUnique {listbox value} {
 
	for {set k 0} {$k < [$listbox size]} {incr k} {

		set lboxval [$listbox get $k]
		if {[string compare $lboxval $value] == 0} {
			return 0
		}
	}
	return 1
}

# lcomp: compares 2 listboxes: returns 0 if the same; 1 otherwise 
proc lcomp {lbox1 lbox2} { 
	set llen1 [llength $lbox1]
	set llen2 [llength $lbox2]
	if {$llen1 != $llen2} {
		return 1
	}
	for {set i 0} {$i < $llen1} {incr i} {
		set elem1 [lindex $lbox1 $i]
		set elem2 [lindex $lbox2 $i]

		if {[string compare $elem1 $elem2] != 0} {
			return 1
		}
	}
	return 0
}