# This file redefines the following commands to provide a uniform interface
# to Tcl-written widgets
#                                                  - Gustaf Neumann

rename getValue            _getValue
rename setValues           _setValues
rename getClass            _getClass
rename getResourceList     _getResourceList
rename getTypeOfAttribute  _getTypeOfAttribute

# current limitations
#  - widget names for tcl written widgets must be specified always by the
#    same name (not once say "myWidget" and another time "*myWidget")
#  - widget class names could not be used via resource mechanisms 
#    (eg FileSelector.filter, where FileSelector is the className)
#  - probably many other as well

proc gV {name resource} {
  global _wafeWidget
  if [info exists _wafeWidget($name)] {
    global _[set wClass $_wafeWidget($name)]
    if [info exists _${wClass}($name,$resource)] {
      return [set _${wClass}($name,$resource)]
    }
  }
  _getValue $name $resource
}
alias getValue gV

proc sV {name args} {
  global _wafeWidget
  if [info exists _wafeWidget($name)] {
    global _[set wClass $_wafeWidget($name)]
    for {set i 0;set nargs [llength $args]} {$i<$nargs} {incr i} {
      set resource [lindex $args $i]
      set value [lindex $args [incr i]]
      if [info exists _${wClass}($name,$resource)] {
	set old [set _${wClass}($name,$resource)]
	if [string compare $old $value] {
	  set _${wClass}($name,$resource) $value
	}
      } else {
	_setValues $name $resource $value
      }
    }
  } else {
    eval _setValues $name $args
  }
}
alias setValues sV

proc getClass {widget} {
  global _wafeWidget
  if [info exists _wafeWidget($widget)] { return $_wafeWidget($widget) }
  _getClass $widget
}

proc getResourceList {widget varName} {
  global _wafeWidget
  upvar 1 $varName rList
  _getResourceList $widget rList
  if [info exists _wafeWidget($widget)] { 
    global _[set wClass $_wafeWidget($widget)]
    # this could be done much more efficient by separting 
    # class and instance information
    foreach i [array names _${wClass}] {
      if [regexp "$widget,(.*)\$" $i match res] { lappend rList $res }
    }
  }
}

proc getTypeOfAttribute {widget resource} {
  global _wafeWidget
  if [info exists _wafeWidget($widget)] { 
    global _[set wClass $_wafeWidget($widget)]
    if [info exists _${wClass}($widget,$resource)] {
    # all Wafe specific resources return currently type String
      return String
    }
  }
  _getTypeOfAttribute $widget $resource
}

proc _defaultValue {w resource class default} {
  set wClass [lindex [info level -1] 0]
  uplevel 1 "upvar #0 _${wClass}($w,$resource) $resource"
  set value [getApplicationResource $w $resource $class]
  if [string match "" $value] {
    set value $default
  }
  uplevel 1 "set $resource {$value}"
}

proc _destroyCallback {widget} {
  global _wafeWidget
  if [info exists _wafeWidget($widget)] { 
    global _[set wClass $_wafeWidget($widget)]
    foreach i [array names _${wClass}] {
      if [regexp "$widget,(.*)\$" $i match res] { unset _${wClass}($i) }
    }
    unset _wafeWidget($widget)
  }
}


