#         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.

# register_default_action: specify the default action (a 'button' activation) when
#     the <Return> key is pressed in a dialog box given by 'toplevel'.
proc register_default_action {toplevel button} {
  global tk_version

  $button configure -relief ridge -borderwidth 3
  bind $toplevel <Return> "catch {$button flash; $button invoke}"
}

proc bind_button1 win {
        global coordX coordY

        bind $win <1> {
                set coordX %X
                set coordY %Y
        }
}

proc bind_canvas {canvasw} {
	global tk_version coordX coordY sysinfo

	if {$tk_version >= 4.0} {
		bindtags $canvasw [list $canvasw]
	}

	bind $canvasw <1> {
                set coordX %X
                set coordY %Y
		popupNodeInfoBox . $sysinfo(nodeframe,%W) \
		   [nodeNameGet $sysinfo(nodeframe,%W)] \
		   [nodeTypeGet $sysinfo(nodeframe,%W)] \
		   [nodeClusterFrameGet $sysinfo(nodeframe,%W)]
	}
}

# bind_entry_readonly: binds an entry to be read only.
proc bind_entry_readonly widget_name {
   $widget_name configure -state disabled
}

# bind_entry_tab: procedure that causes the 'entry_name' widget to pass the input 
# 	focus to  the 'next_entry_name' widget when the <tab> key is hit on the
#       former, or to 'prev_entry_name'  when <Control-b> is pressed.
proc bind_entry_tab {entry_name next_entry_name prev_entry_name} {
  global next$entry_name
  global prev$entry_name
  global sel$entry_name
  global tk_version

  if {$tk_version >= 4.0} {
    bindtags $entry_name [list all Entry $entry_name]
  }

  set next$entry_name $next_entry_name
  set prev$entry_name $prev_entry_name

  bind $entry_name <Tab> {
   focus ${next%W}
   if {$tk_version >= 4.0} {
      	${next%W} xview moveto 1
   }
   if [set sel${next%W}] {
	${next%W} select from 0
	${next%W} select to end
   }
  }
  bind $entry_name <Control-f> {

   focus ${next%W}
   if {$tk_version >= 4.0} {
      ${next%W} xview moveto 1
   }
   if [set sel${next%W}] {
	${next%W} select from 0
	${next%W} select to end
   }
  }

  bind $entry_name <Control-b> {
   
   focus ${prev%W}
   if {$tk_version >= 4.0} {
      ${prev%W} xview moveto 1
   }
   if [set sel${prev%W}] {
	${prev%W} select from 0
	${prev%W} select to end
   }
  }
}

# bind_entry_overselect: creates a set of bindings for a user-friendly entry widget.
# 	This includes features such as overwriting selected text, copying and pasting
#	text solely using mouse buttons, use of basic editing keys: left and right
#	arrow keys.
proc bind_entry_overselect {entry_name} {
  global tk_version

  if {$tk_version >= 4.0} {
    return
  } 

  bind $entry_name <1> {
    %W icursor @%x
    %W select clear
    %W select from @%x
    if {[lindex [%W config -state] 4] == "normal"} {
       focus %W
    }
  }

  bind $entry_name <Any-KeyPress> {
## Overwrite the selected region - the selected text is treated as a unit.
## 
    catch {%W delete sel.first sel.last}

    if {[string compare %A ""] != 0} {
        %W insert insert %A
        tk_entrySeeCaret %W
    }
  }
  bind $entry_name <2> {
    catch {%W insert insert [selection get]}
    selection clear %W
    
    tk_entrySeeCaret %W
  }
  bind $entry_name <B2-Motion> {%W scan dragto %y}

  bind $entry_name <Delete> {

## Delete selection if any.
    if [catch {%W delete sel.first sel.last}] {
      tk_entryBackspace %W
    }
    tk_entrySeeCaret %W
  }

  bind $entry_name <BackSpace> {

## Delete selection if any.
    if [catch {%W delete sel.first sel.last}] {
      tk_entryBackspace %W 
    }
    tk_entrySeeCaret %W
  }
  bind $entry_name <Control-h> {
## Delete selection if any.
    if [catch {%W delete sel.first sel.last}] {
      tk_entryBackspace %W 
    }
    tk_entrySeeCaret %W
  }
  bind $entry_name <Control-d> {
    %W delete sel.first sel.last
    tk_entrySeeCaret %W
 }
  bind $entry_name <Control-u> {%W delete 0 end}
  bind $entry_name <Control-v> {
    %W insert insert [selection get]

    tk_entrySeeCaret %W
  }
  bind $entry_name <Control-w> {
    tk_entryBackword %W

    tk_entrySeeCaret %W
  }

  bind $entry_name <Key-Right> {
    set c [ expr [%W index insert] + 1]
    %W icursor $c
    %W select from $c

    tk_entrySeeCaret %W
  }
  bind $entry_name <Key-Left> {
    set c [ expr [%W index insert] - 1]
    %W icursor $c
    %W select from $c

    tk_entrySeeCaret %W
  }

}

proc bind_entry_return {entry_name cmdButton} {
  global tk_version

  global button$entry_name
  set button$entry_name $cmdButton

  bind $entry_name <Return> {
	${button%W} invoke
  }
}

# bind_entry_shared_scrollbar: a special procedure that binds a "reserved" scrollbar
#	to 'entry_name.
proc bind_entry_shared_scrollbar {entry_name shared_scrollbar} {
  global tk_version scroll$entry_name

  set scroll$entry_name $shared_scrollbar

  bind $entry_name <1> {
    %W icursor @%x
    %W select clear
    %W select from @%x
    if {[lindex [%W config -state] 4] == "normal"} {
       focus %W
       if {$tk_version < 4.0} {
	  if {[lindex [%W configure -scrollcommand] 4] == ""} {
             %W configure -scrollcommand "${scroll%W} set"
          }
          ${scroll%W} configure -command "%W view"
       } else {
	  if {[lindex [%W configure -xscrollcommand] 4] == ""} {
             %W configure -xscrollcommand "${scroll%W} set"
          }
          ${scroll%W} configure -command "%W xview"
       }
    }
  }
}

# register_spinbox: place an appropriate binding to 'entry_name' so that it 
# 	behaves like a spinbox entry.
proc register_spinbox entry {
  global tk_version vlist.$entry

  if {$tk_version >= 4.0} {
    bindtags $entry [list all Entry $entry]
  }

  bind $entry <Any-KeyPress> {
    if {$tk_version < 4.0} {
      catch {%W delete sel.first sel.last}

      if {[string compare %A ""] != 0} {
        %W insert insert %A
        tk_entrySeeCaret %W
      }
    }
    set valueList ${vlist.%W}
    set sbox_var [%W get]
    if [regexp "(\[-0-9]+)-(\[-0-9]+)" $valueList match min max] {

	if { $min >= 0 } {
            if { ![regexp "^(\[0-9]+)$" $sbox_var match] || \
	         $sbox_var < $min || $sbox_var > $max } {
	        %W delete 0 end
	    }
	} else {
	    set firstChar [string index $sbox_var 0]
	    set restOfChar [string range $sbox_var 1 end]

	    if { ![regexp "^(\[-0-9]+)$" $firstChar match] } {
	        %W delete 0 end
	    } elseif {[string compare $restOfChar ""] != 0} {

		  if { ![regexp "^(\[0-9]+)$" $restOfChar  match] || \
			 $sbox_var < $min || $sbox_var > $max } {
	        	%W delete 0 end
		  }
	    }
        }
    } elseif { ([lsearch -exact ". ^ $ \[ ] ( ) * + ? |" $sbox_var] != -1 && \
                [lsearch -exact $valueList $sbox_var] == -1) || \
                [lsearch -regexp $valueList "^${sbox_var}"] == -1 } {
       %W delete 0 end
    }
  }

  bind $entry <FocusOut> {
    check_spinbox_value %W
  }
}
proc register_entry_fixsize {entry size} {
  global tk_version size.$entry

  set size.$entry $size

  if {$tk_version >= 4.0} {
    bindtags $entry [list all Entry $entry]
  }

  bind $entry <Any-KeyPress> {
    set size ${size.%W}
    set sbox_var [%W get]
    if {[string length $sbox_var] < $size} {
      if {$tk_version < 4.0} {
        catch {%W delete sel.first sel.last}

        if {[string compare %A ""] != 0} {
          %W insert insert %A
          tk_entrySeeCaret %W
        }
      }
    } else {
      if {$tk_version >= 4.0} {
	 %W delete 0 end
         %W insert 0 [string range $sbox_var 0 [expr $size - 1]]
      }
    }
  }
}

# bind_listbox_single_select: binds a listbox to allow only one item selection at a
# time.
proc bind_listbox_single_select widget_name {
  global tk_version

  if {$tk_version < 4.0} {
    bind $widget_name <B1-Motion> {;}
    bind $widget_name <Shift-1> {;}
    bind $widget_name <Shift-B1-Motion> {;}
    bind $widget_name <2> {;}
    bind $widget_name <B2-Motion> {;}
  } else {
    $widget_name configure -selectmode single
  }
}

proc bind_listbox_select {listbox boxframe} {

   global tk_version box$listbox

   set box$listbox $boxframe

   if { $tk_version >= 4.0 } {
     bindtags $listbox [list all Listbox $listbox]
   }

    bind $listbox <1> {
        if { $tk_version < 4.0 } {
          %W select from [%W nearest %y]
	  boxSelect ${box%W} [%W index @%x,%y]
        }
	boxSelect ${box%W} [%W index @%x,%y]
    }
}

proc set_listbox_cmd {lbox cmdexpr} {
  global cmd$lbox

  set cmd$lbox $cmdexpr
}

proc bind_text_readonly widget_name {
  global tk_version

  if {$tk_version >= 4.0} {
    bindtags $widget_name [list $widget_name]
  }

  bind $widget_name <1> {;}
  bind $widget_name <Double-1> {;}
  bind $widget_name <Triple-1> {;}
  bind $widget_name <B1-Motion> {;}
  bind $widget_name <Shift-B1-Motion> {;}
  bind $widget_name <Return> {;}
  bind $widget_name <BackSpace> {;}
  bind $widget_name <Delete> {;}
  bind $widget_name <Control-h> {;}
  bind $widget_name <Control-d> {;}
  bind $widget_name <Control-v> {;}
}
