# PwdEntry, a Wafe Widget Class for password entries
#
# This widget is actually a configured Athena Text widget
# which displays stars when a password is typed in or
# is set via "sV $name string $value". [gV name string]
# returns the password string
#
# Gustaf Neumann,           Mohegan Lake, Jan 27, 1993

proc PwdEntry {name parent args} {
  global _wafeWidget
  set resList {}
  set wClass [lindex [info level 0] 0]

  if [_managedWidget args] { 
    set id [Text $name $parent]
  } else { 
    set id [Text $name $parent unmanaged]
  }

  set _wafeWidget($id) $wClass

  for {set i 0;set nargs [llength $args]} {$i<$nargs} {incr i} {
    switch [lindex $args $i] {
      string      { set string [lindex $args [incr i]] }
      type        { incr i }
      editType    { incr i }
      default     { 
	lappend resList [lindex $args $i]
	lappend resList [lindex $args [incr i]]
      }
    }
  }

  sV $id \
    destroyCallback {_destroyCallback %W} \
    editType edit \
    type string \
    translations {#override
      <Key>: exec(_PwdInsertCharacter %W {%s} {%a})
    }

  _defaultValue $id string String ""
  trace variable string w _${wClass}_change

  if [string compare "" $resList] {
    eval _setValues $id $resList
  }
  if [string compare "" $string] {
    _setValues $id string [_nstars [string length $string]]
  }
  return $id
}

proc _PwdInsertCharacter {widgetId keysym char} {
  global _PwdEntry
  switch -exact $keysym {
    BackSpace { sV $widgetId string "" }
    default {
      if [string compare "" $char] {
	sV $widgetId string [gV $widgetId string]$char
      }
    }
  }
}

proc _nstars {n} {
  for {} {$n>10} {incr n -10} { append stars ********** }
  append stars [string range *********** 1 $n]
  return $stars
}

proc _PwdEntry_change {class instanceAtt op} {
  global $class
  regexp {^(.*),(.*)$} $instanceAtt all id res
  set newValue [set ${class}($instanceAtt)]
  switch -exact $res {
    string {
      _setValues $id string [_nstars [string length $newValue]]
      callActionProc $id {} end-of-line
    }
  }
}

