# 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 class names could not be used via resource mechanisms 
#    (eg FileSelector.filter, where FileSelector is the className)
#  - probably many other as well

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

proc sV {widgetRef args} {
  global _wafeWidget
  set id [widgetId $widgetRef]
  if [info exists _wafeWidget($id)] {
    global _[set wClass $_wafeWidget($id)]
    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}($id,$resource)] {
	set old [set _${wClass}($id,$resource)]
	if [string compare $old $value] {
	  global _oldResourceValue $old
	  set _${wClass}($id,$resource) $value
	}
      } else {
	_setValues $id $resource $value
      }
    }
  } else {
    eval _setValues $id $args
  }
}
alias setValues sV

proc getClass {widgetRef} {
  global _wafeWidget
  set id [widgetId $widgetRef]
  if [info exists _wafeWidget($id)] { return $_wafeWidget($id) }
  _getClass $id
}

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

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

proc _managedWidget {argListName} {
  upvar $argListName argList
  if [string compare [lindex $argList 0] unmanaged] {
    return 1
  }
  lreplace $ $argList 0 1
  return 0
}

# the widgetClass must be present in the callers environment
# in a variable named wClass
proc _defaultValue {widgetId resource class default} {
  upvar wClass wClass
  uplevel 1 "upvar #0 _${wClass}($widgetId,$resource) $resource"
  set value [getApplicationResource $widgetId $resource $class]
  if [string match "" $value] {
    set value $default
  }
  uplevel 1 "set $resource {$value}; lappend resources $resource"
}

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


