Open Mash Cross Reference
mash/tcl/common/ui-util.tcl

   # ui-util.tcl --
   #
   #       FIXME: This file needs a description here.
   #
   # Copyright (c) 1993-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
   # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, 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.
  #
  # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/ui-util.tcl,v 1.25 2004/05/27 01:44:08 aswan Exp $
  
  import Entry
  
  set nids 0
  proc uniqueID { } {
          global nids
          incr nids
          return $nids
  }
  
  proc isCIF fmt {
          # only supported CIF format is h.261
          if { $fmt == "h261" } {
                  return 1
          }
          return 0
  }
  
  #
  # Return true if the two strings provide more or less the
  # same informational content
  #
  proc cname_redundant { name cname } {
          set ni [string first @ $name]
          if { $ni < 0 } {
                  return 0
          }
          set ci [string first @ $cname]
          if { $ci < 0 } {
                  return 0
          }
          if { [string compare \
                  [string range $name 0 $ni] \
                  [string range $cname 0 $ci]] == 0 } {
                  return 1
          }
          return 0
  }
  
  set current_icon_mark "FIXME"
  
  proc mk.key w {
          puts stderr "Use the new KeyEditor class"
          exit 1
  }
  
  #
  # A KeyEditor is a widget composed of a toggle button and an
  # text entry box.  (Here "Key" refers to an encryption key
  # not a keyboard key.)  The constructor takes a window to
  # embed the widget into and a crypt object upon which the
  # install-key method is dispatched to set the key to reflect
  # user changes.  install-key "" means encryption is disabled.
  # install-key returns 0 if the operation is successful or less
  # than 0 if the operation failed (e.g., the key was illegal)
  #
  Class KeyEditor
  
  KeyEditor instproc init { w crypt } {
          $self instvar crypt_ entry_ win_
          set crypt_ $crypt
          set win_ $w
          frame $w.key
          checkbutton $w.key.button -text "Encryption Key:" -relief flat \
                  -font [$self get_option smallfont] \
                  -command "$self toggle" -variable [$self tkvarname encryptOn_]\
                  -disabledforeground gray40
          set key [$self get_option sessionKey]
 
         # pass in $self so that Entry will call {$self update key}
         # when key is set
         set entry_ [new Entry $w.key.entry $key $self]
         $self set-key $key
         pack $w.key.button -side left
         pack $w.key.entry -side left -fill x -expand 1
 }
 
 KeyEditor instproc disable {} {
         $self instvar win_
         $win_.key.button configure -state disabled
 }
 
 KeyEditor instproc enable {} {
         $self instvar win_
         $win_.key.button configure -state normal
 }
 
 KeyEditor instproc set-key key {
         $self tkvar encryptOn_
         $self instvar crypt_ entry_
         if { $key == "" } {
                 $crypt_ crypt_clear
                 set encryptOn_ 0
                 $self disable
         } elseif { [$crypt_ install-key $key] != "" } {
                 # illegal key - clear the entry
                 $self disable
                 set encryptOn_ 0
                 $entry_ clear
         } else {
                 $self enable
                 set encryptOn_ 1
         }
 }
 
 KeyEditor instproc toggle {} {
         $self instvar crypt_ entry_
         $self tkvar encryptOn_
         if $encryptOn_ {
                 $crypt_ install-key [$entry_ entry-value]
         } else {
                 $crypt_ install-key ""
         }
 }
 
 KeyEditor instproc update key {
         set key [string trim $key]
         $self set-key $key
         return 0
 }
 
 Class TextEntry -superclass Entry
 TextEntry instproc init { target w text } {
         $self next $w $text
         $self set target_ $target
 }
 
 TextEntry instproc update s {
         $self instvar target_
         if { $s != "" } {
                 set s [string trim $s]
         }
         if {$target_ == {}} {
                 return 0
         } else {
                 return [eval $target_ \"$s"]
         }
 }