# scriptdep.tcl
#
#        Este fichero implementa la generación de los scripts asociados
#        a las dependencias.
#
# Copyright (c) 2000 CIMNE
#

# Procedimiento LabelField --
#
#      Genera una referencia (LABEL) al campo dado en los argumentos $TYPE,$FIELD.
#      Retorna el indece del campo y crea el indice asociativo:
#                GidData($TYPE,LABEL,$FIELD)
#
# Argumentos:
#
#      $GDN     --> Npmbre de la estructura.
#      $TYPE    --> Encabezamiento de la estructura.
#      $FIELD   --> Nombre del campo (QUESTION).
#
# Resultados:
#
#      Crea el indice GidData($TYPE,LABEL,$FIELD) cuyo valor es la posición de
#      la QUESTION con valor $FIELD dentro de GidData. Retorna la posición.
#      Si no existe el campo QUESTION con ese valor retorna -1

catch {
    LoadDebugger
}

proc LabelField { GDN TYPE FIELD } {
    upvar \#0 $GDN GidData
    
    # ---- Busco el campo QUESTION ----

    set idxlist [array names GidData $TYPE,QUESTION,*]

    set idxfound -1

    foreach idx $idxlist {
	   #            if { [regexp ^$FIELD $GidData($idx)] } {}
	   if { [string equal -nocase $FIELD $GidData($idx)] } {
	       regexp (?:.)+QUESTION,(.+) $idx {} idxfound
	       set GidData($TYPE,LABEL,$FIELD) $idxfound
	       break
	   }
    }
    if { $idxfound == -1 } {
	   foreach idx $idxlist {
	       #            if { [regexp ^$FIELD $GidData($idx)] } {}
	       if {[string equal -nocase -length [string length $FIELD] $FIELD $GidData($idx)]} {
		      regexp (?:.)+QUESTION,(.+) $idx {} idxfound
		      set GidData($TYPE,LABEL,$FIELD) $idxfound
		      break
	       }
	   }
    }
    return $idxfound
}

proc IsInteger { n } {
    return [expr ![catch { format "%d" $n }]]
}

proc IsReal { n } {
    return [expr ![catch { format "%g" $n }]]
}

proc IsUnit { str } {
    set real {^(-|\+)?(\d+\.?\d*|\d*\.?\d+)(E(-|\+)?\d+)?}
    return [regexp -nocase -- $real $str]
}

proc IsScalar { str } {
    if { [IsReal $str] || [IsUnit $str] } {
	   return 1
    }
    return 0
}

proc CheckCondition { cnd } {
    foreach tc [list ovpnt ovline ovsurf ovvol] {
	   if { [lsearch [.central.s info conditions $tc] $cnd] != -1 } {
	       return 1
	   }
    }
    return 0
}

proc CheckInterval { intv } {
    if { [IsInteger $intv] && 
	    $intv >= 1 && $intv <= [lindex [.central info intvdata num] 1] } {
	   return 1
    }
    return 0
}

proc CheckMaterial { mat } {
    if { [lsearch [.central.s info materials] $mat] == -1 } {
	   return 0
    }
    return 1
}

proc CheckPrb { dummy } {
    return 1
}

# _ParserReference :-
#
#    dado <TipoDato>.<Miembro>.<Propiedad>
#    produce 

proc _ParserReference { Ref } {

    set lst [split $Ref .]

    # verifico que todo fue ok

#     WarnWinText "Dividi en $lst"

    # Retorno rapido, ver el codigo siguiente
    # por que lo salto.

    return $lst

    foreach e $lst {
	   set l [string length $e]
	   set isep -1
	   if $l {
	       set isep [string wordend $e 0]
	       
	   }
	   if { $isep != $l } {
	       #puts "Referencia invalida $Ref puesto que $isep != $l"
	       return 0;
	   }
    }
    return $lst
}

# Procedimiento ParserReference --
#
#    Analiza una referencia a una propiedad y retorna una lista
#    con el tipo y valor de la referencia.
#
# Argumentos:
#
#    GDN --> nombre de la estructura GidData.
#    Ref --> referencia a analizar. Ej:
#            - conditions.constraint.X (referencia global)
#            - constraint.X (referencia local al tipo de GDN(class)
#            - X (referencia local al miembro actual de GDN(TYPEFUNC)
#            - #...# literal
# Resultados:
#    retorna una lista con la siguiente estructura:
#
#       (const|local|global|error|warning ...)
#
#       const  :- $Ref es una constante
#
#       local  :- (local <idx>), 
#                <idx> indice de la question <prop> ==> GidData($TYPE,QUESTION|VALUE,$<idx>
#
#       global :- (global <tipo> [<member>] <prop>])
#
#       error  :- (error <msg>)
#       warning :- (warning <msg>) 
#               similar a constante.
#

proc ParserTryConstant { RefName } {
    upvar $RefName Ref

    if {[string is double $Ref] || [IsUnit $Ref] || [regexp \#(.+)\# $Ref]} {
	   return 1
    } elseif {[regexp ^\"(.*)\"$ $Ref {} _Ref]} {
	   # extract contents of string constant
	   set Ref [DWSpace2Under $_Ref]
	   return 1
    } 
    return 0
}

proc ParserReference { GDN TYPE Ref {rvalue 0}} {
    upvar \#0 $GDN GidData

    # verifico si es una constante trivial.

    if { [ParserTryConstant Ref] } {
	   return [list const $Ref]
    }

    set NoConst 0
    if {$rvalue} {
	   if {[string range $Ref 0 1] eq "->"} {
	       set Ref [string range $Ref 2 end]
	       set NoConst 1
	   } else {
	       return  [list const $Ref]
	   }
    }

    # intento resolver localmente

    if { [catch {set ifld $GidData($TYPE,LABEL,$Ref)}] } {
	   set ifld [LabelField $GDN $TYPE $Ref]
    }
    if { $ifld != -1 } {
	   # pude etiquetar o ya estaba etiquetado,
	   # asi que asumo referencia global.

	   return [list local $Ref $ifld]
    }
    
    set lst [_ParserReference $Ref]
    
    if { $lst == 0 } {
	   return [list error "empty reference"]
    }
    
    set n [llength $lst]
    
    if { $n > 3 } {
	   return [list const $Ref]
    }
    
    array set arrTypes {
	   class {conditions materials intvdata gendata}
	   CND conditions
	   MAT materials
	   ID  intvdata
	   PD  gendata
	   conditions CND
	   materials  MAT
	   intvdata   ID
	   gendata    PD
	   conditions,hm  1
	   conditions,chm CheckCondition
	   materials,hm   1
	   materials,chm  CheckMaterial
	   intvdata,hm    1
	   intvdata,chm   CheckInterval
	   gendata,hm     0
    }

    set top $GidData(top)
    
    set refTYPE ""
    switch $n {
	   1 {
	       set property [lindex $lst 0]
	       set refTYPE $TYPE
	   }
	   2 {
	       set class [lindex $lst 0]
	       set property [lindex $lst 1]
	       # verfico si coincide con una clase
	       if { [lsearch $arrTypes(class) $class] != -1 } {
		      if { $class == "intvdata" } {
		          if [IsInteger $property] {
		                 # Posible referencia a un intervalo
		                 # sin propiedad.
		                 return [list warning "interval reference without a property"]
		          }
		          return [list "global" "intvdata" $property]
		      }
		      if { $arrTypes($class,hm) } {
		          # tiene miembros 
		          # ==> falta la referencia a la propiedad
		          return [list warning "reference to $class\.$property without a property"] 
		      }
		      set argRef [list $class $property]
	       } else {
		      # es una referencia member.property local
		      set member $class
		      set class $arrTypes($top)
		      if { !$arrTypes($class,hm) } {
		          # no admite miembros 
		          # ==> hay referencia extra
		          #return [list warning "$class does not have members"]
		          return [list const $Ref]
		      }
		      if { [eval $arrTypes($class,chm) $member] } {
		          set argRef [list $class $member $property]
		      } else {
		          # no es un miembro reconocido de $class
		          return [list const $Ref]
		      }
	       }
	   }
	   3 {
	       set class   [string tolower [lindex $lst 0]]
	       if { [lsearch $arrTypes(class) $class] == -1 } {
		      # no se reconoce la clase
		      return [list const $Ref]
	       }
	       if { $arrTypes($class,hm) == "no" } {
		      # no admite miembros 
		      # ==> hay referencia extra
		      return [list warning "$class does not have members"]
	       }
	       set member   [lindex $lst 1]
	       set property [lindex $lst 2]
	       
	       #                WarnWinText "$class $member $property"

	       if { $class == "intvdata" } {
		      if { [IsInteger $member] && $member > 0 } {
		          return [list "global" "invdata" $member $property]
		      } else {
		          # El miembro de intvdata debe ser
		          # entero positivo
		          return [list error "intvdata member must be integer"] 
		      }
	       }
	       set argRef [list $class $member $property]
	   }
    }
    
    if { $refTYPE == "" && $arrTypes($class) == $top } {
	   # n == 2 o 3 y  top de Ref coincide con top de GidData
	   if { $n == 2 } {
	       set refTYPE $top
	   } else {
	       set refTYPE $top,$member
	   }
    }
    if { [string equal $refTYPE $TYPE]  } {
	   #intento etiquetar localmente
	   set ifld -1
	   if { [catch {set ifld $GidData($refTYPE,LABEL,$property)}] } {
	       set ifld [LabelField $GDN $refTYPE $property]
	   }
	   if { $ifld == -1 } {
	       # no se pudo etiquetar
	       # ==> es una constante o una referencia global,
	       # o local en otro book para ID o PRB

	       if { $n == 1 } {
		      if { $top == "ID" } {
		          if { [_isprbquestion 0 $property] } {
		                 # estoy en ID y no pude etiquetar localmente
		                 # pero property esta en otro book de ID

		                 return [list "global" "intvdata" $GidData(ID,currentinterval) $property]
		          } else {
		                 return [list warning "invalid global intvdata reference"]
		          }
		      }
		      if { $top == "PD" } {
		          if { [_isprbquestion 1 $property] } {
		                 # estoy en PRB y no pude etiquetar localmente
		                 # pero property esta en otro book de PRB

		                 return [list "global" "gendata" $property]
		          } else {
		                 return [list warning "invalid global gendata reference"]
		          }
		      }
		      # no es otra cosa que una constante
		      return [list const $Ref]
	       }
	   } else {
	       # se pudo etiquetar y por tanto es una referencia local
	       return [list "local" $property $ifld]
	   }
    }
    return [concat "global" $argRef]
}

proc ArrangeDefault { lstdep } {
    set defdep {}
    set headdep {}
    foreach dep $lstdep {
	   if ![string compare "default" [lindex $dep 0]] {
	       lappend defdep $dep
	   } else {
	       lappend headdep $dep
	   }
    }
    return [concat $headdep $defdep]
}

# Procedimiento ScriptGen --
#
#       Retorna el script asociado al elemento Idx dentro de la estructuda
#       con nombre GDN.
#
# Argumentos:
#
#       GDN     --> Nombre de la estructura GidData.
#       TYPE    --> Tipo de la estructura: CND, MAT, ID, PD
#       Idx     --> Indice del campo.
#       DepList --> Lista de depemndencias asociadas al comapo.
#
# Resultados:

proc ScriptGen { GDN TYPE Idx DepList ScriptName ErrName } {
    upvar \#0 $GDN GidData
    upvar $ScriptName Script
    upvar $ErrName Err
    
    set Err ""
    
    # Referencio la estructura Global con nombre $GDN

    set    Script "{ upvar \#0 $GDN GidData;\n"
    append Script {if { $GidData(DEPDISABLED) } return;} "\n"

    #append Script "WarnWin Activando...;\n"

    # Tomo el valor  actual del campo

# Comentado
#     if { $GidData($TYPE,TYPE,$Idx) == "UNITS" } {
#         append Script "set __V__ " {$GidData} "($TYPE,VALUENUM:$Idx);\n"
#     } else {
#         append Script "set __V__ " {$GidData} "($TYPE,VALUE,$Idx);\n"
#     }
    
    #regsub -all --  {\)} \\) $TYPE _TYPE

    append Script "set __TYPE__ $TYPE;\n"

    append Script "set __V__ " {$GidData} "(\$__TYPE__,VALUE,$Idx);\n"

    # genero la sentencia switch.
    
    append Script "switch -- " {$__V__} " {\n"
    
    # adiciono cada una de las sentencias case.

    set DepList [ArrangeDefault $DepList]
    
    foreach Dep $DepList {
	   set CV  "\"[lindex $Dep 0]\""
	   set ActionList  [lindex $Dep 1]
	   append Script "$CV "
	   if { $ActionList == "-" } {
	       append Script " -\n"
	   } else {
	       append Script " {\n"
	       foreach Action $ActionList {
		      set CA  [lindex $Action 0]
		      set CL  [lindex $Action 1]
		      set CNV [lindex $Action 2]

		      regsub -all {\[} $CNV {\\[} CNV

		      # WarnWin "Referenciando $TYPE: ..."

		      switch $CA {
		          CONDITION {
		          }
		          TITLESTATE {
		          }
		          default {

		                 set leftValue [ParserReference $GDN $TYPE $CL]
		                 
		                 switch [lindex $leftValue 0] {
		                     warning -
		                     error {
		                            set Err "[lindex $leftValue 1] in left value $CL"
		                            return 0
		                     }
		                     const {
		                            set Err "(const) invalid left value reference $CL"
		                            return 0
		                     }
		                     local -
		                     global {
		                     }
		                     default {
		                            set Err "$leftValue - Internal error processing left value $CL"
		                            return 0
		                     }
		                 }
		                 set rightValue [ParserReference $GDN $TYPE $CNV 1]
		                 
		                 switch [lindex $rightValue 0] {
		                     warning {
		                            #WarnWinText "[lindex $rightValue 1] in right value $CNV assuming const"
		                            set rightValue [list const $CNV]
		                     }
		                     error {
		                            set Err "[lindex $rightValue 1] in right value $CNV"
		                            return 0
		                     }
		                     const -
		                     local -
		                     global {
		                     }
		                     default {
		                            set Err "$rightValue - Internal error processing right value $CNV"
		                            return 0
		                     }
		                 }
#                                 if { $leftValue == 0 || [lindex $leftValue 0] == "const" } {
#
		                     # leftValue no puede ser constante
		                     # Comentado, 22/02/01
		                     #set Err "Invalid left value reference: $CL"
		                     #return 0

#                                      if { [catch {set ifld $GidData($TYPE,LABEL,$CL)}] } {
#                                             set ifld [LabelField $GDN $TYPE $CL]
#                                      }
#                                      if { $ifld == -1 } {
#                                             set Err "Invalid left value reference: $CL"
#                                             return 0
#                                      }
#                                      set leftValue [list "local" $CL $ifld]
#                                     set Err "Invalid left value reference: $CL"
#                                     return 0
#                                 }
#                                 set rightValue [ParserReference $GDN $TYPE $CNV]
		                 #WarnWinText "rightValue $rightValue"
#                                 if { $rightValue == 0 } {
#                                     set rightValue [list "const" $CNV]
#                                 }
		          }
		      }
		          #WarnWinText "CallDepAction Action $GDN \"$TYPE\" \{$leftValue\} \{$rightValue\} ;\n"
		      switch $CA {
		          HIDE {
		                 append Script "CallDepAction DepActionHIDE $GDN \"$TYPE\" \{$leftValue\} \{$rightValue\} ;\n"
		          }
		          SET {
		                 append Script "CallDepAction DepActionSET $GDN \"$TYPE\" \{$leftValue\} \{$rightValue\} ;\n"
		          }
		          RESTORE {
		                 append Script "CallDepAction DepActionRESTORE $GDN \"$TYPE\" \{$leftValue\} \{$rightValue\} ;\n"
		          }
		          CONDITION {
		                 append Script "DepActionCONDITION $GDN $CL $CNV;\n"
		          }
		          TITLESTATE {
		                 append Script "DepActionTITLESTATE $GDN \"$TYPE\" $CL $CNV;\n"
		          }
		          default {
		                 set Err "Internal error: Unknown action!!!!. See the parser."
		                 return 0
		          }
		      }
	       }
	       append Script "}\n"
	   }
    }
    
    # cierro la sentencia switch y el upvar.
    
    append Script "}\n}\n"

    return 1
}

proc CallDepAction { ACTION GDN TYPE leftValue rightValue } {
  upvar \#0 $GDN GidData
  
  set typeLRef [lindex $leftValue 0]
  set typeRRef [lindex $rightValue 0]
  
  # obtengo el valor referenciado por rightValue
  switch $typeRRef {
    "const" {
      set rv [lindex $rightValue 1]
    }
    "local" {
      set rv $GidData($TYPE,VALUE,[lindex $rightValue end])
    }
    default {
      # debe ser "global" hay que pedir a GidAccessValue
      set rv [eval [concat _GidAccessValue $GDN get [lrange $rightValue 1 end]]]
    }
  }
  
  if { $typeLRef == "local" } {
    eval [list $ACTION $GDN $TYPE [set idx [lindex $leftValue end]] $rv]
    if {[info exists GidData($TYPE,TKWIDGET,$idx)]} {
      DWSendTKWIDGETEvent $GDN $TYPE $idx "DEPEND" [string range $ACTION 9 end] $rv
    }
  } else {
    switch $ACTION {
      DepActionSET {
	set state disabled
      }
      DepActionRESTORE {
	set state normal
      }
      DepActionHIDE {
	set state hidden
      }
    }
    eval [concat _GidAccessValue $GDN set [lrange $leftValue 1 end] $rv $state]
  }
}

proc DepSetScalar { GDN TYPE Idx NewValue } {
    upvar \#0 $GDN GidData

    set GidData($TYPE,VALUE,$Idx) $NewValue
}

proc DepSetScalarUnit { GDN TYPE Idx NewValue } {
    upvar \#0 $GDN GidData
    
    set GidData($TYPE,VALUENUM,$Idx) $NewValue
}

proc DepSetVarValue { GDN TYPE Idx NewValue } {
    upvar \#0 $GDN GidData

    if { ([lindex $NewValue 0] != "\#N\#") || ![regexp {^[ ]*[1-9]+[0-9]*[ ]*$} [lindex $NewValue 1]] } {
	   WindowMessage "Invalid value $NewValue for field $GidData($TYPE,QUESTION,$Idx)"
    } else {
	   set j 1
	   foreach cell [lrange $NewValue 2 end] {
	       set GidData($TYPE,VALUE,$Idx,$j) $cell
	       incr j
	   }
    }
}

proc DepRef2Value { GDN TYPE refFld refValue } {
    set typeValue [lindex $refValue 0]
    switch $typeValue {
	   const {
	       set newValue [lindex $refValue end]
	   }
	   local {
	   }
    }
}

proc DepActionSET { GDN TYPE Idx NewValue } {
  upvar \#0 $GDN GidData
  
  if [info exists GidData($TYPE,WIDGET,$Idx)] {
    set WInfo $GidData($TYPE,WIDGET,$Idx)
    set W     [lindex $WInfo 0]
    set WL    [lindex $WInfo 1]
  } else {
    # Esta en GidData pero no visible
    set W ""
    set WL ""
  }
  
  # Deshabilitar el control
  
  switch $GidData($TYPE,TYPE,$Idx) {
    
    "UNITS" {
      set CallSet DepSetScalar
      if { $W != "" } {
	if { [info exists GidData($TYPE,INSTANCE,$Idx)] } {
	  $GidData($TYPE,INSTANCE,$Idx)::\Disabled
	} else  {
	  # Puede ser ser solo un edit.
	  
	  catch {
	    $W conf -state disabled -fg gray60
	  }
	  
	  # y esto en caso de frame
	  
	  foreach i [winfo children $W] {
	    catch {
	      $i conf -state disabled -fg gray60
	    }
	  }
	}
      }
    }
    "GRID" {
      #set CallSet DepSetVarValue
      set CallSet DepSetScalar
      if { $W != "" } {
	# el widget es un frame
	foreach i [winfo children $W] {
	  catch {
	    $i conf -state disabled -fg gray60
	  }
	}
      }
    }
    default {
      set CallSet DepSetScalar
      if { $W != "" } {
	catch {
	  $W configure -state disabled -fg gray60
	}
      }
    }
  }
  
  if { $WL != "" } {
    $WL configure -fg gray60
  }
  
  if { [string toupper $NewValue] ne "#CURRENT#" } {  
    eval [list $CallSet $GDN $TYPE $Idx $NewValue]
  }
  set GidData($TYPE,STATE,$Idx) disabled
}

proc DepActionRESTORE { GDN TYPE Idx NewValue } {
  upvar \#0 $GDN GidData
  
  if [info exists GidData($TYPE,WIDGET,$Idx)] {
    set WInfo $GidData($TYPE,WIDGET,$Idx)
    set W     [lindex $WInfo 0]
    set WL    [lindex $WInfo 1]
  } else {
    # Esta en GidData pero no visible
    set W ""
    set WL ""
  }
  
  # Habilitar el control, hay que verificar si esta mapeado, en caso negativo hay que
  # recordarlo en la grid.
  
  switch $GidData($TYPE,TYPE,$Idx) {
    "UNITS" {
      set CallSet DepSetScalar
      if { $W != "" } {
	if { [info exists GidData($TYPE,INSTANCE,$Idx)] } {
	  $GidData($TYPE,INSTANCE,$Idx)::\Enabled
	} else  {
	  # Puede ser ser solo un edit.
	  
	  catch { 
	    $W conf -state normal -fg black
	  }
	  
	  # y esto en caso de frame
	  
	  foreach i [winfo children $W] {
	    catch {
	      $i conf -state normal -fg black
	    }
	  }
	}
      }
    }
    "GRID" {
      #set CallSet DepSetVarValue
      set CallSet DepSetScalar
      if { $W != "" } {
	# el widget es un frame
	foreach i [winfo children $W] {
	  catch {
	    $i conf -state normal -fg black
	  }
	}
      }
    }
    default {
      set CallSet DepSetScalar
      if { $W != "" } {
	catch {
	  $W configure -state normal -fg black
	}
      }
    }
  }
  if { $WL != "" } {
    $WL configure -fg black
  }
  
  if { $W != "" && ![winfo ismapped $W] } {
    grid $W
    if { $WL != "" } {
      grid $WL
    }
  }
  
  if { [string toupper $NewValue] ne "#CURRENT#" } {
  
    eval [list $CallSet $GDN $TYPE $Idx $NewValue]
  }
  
  set GidData($TYPE,STATE,$Idx) normal
}

proc DepActionHIDE { GDN TYPE Idx NewValue } {
  upvar \#0 $GDN GidData
  
  if [info exists GidData($TYPE,WIDGET,$Idx)] {
    set WInfo $GidData($TYPE,WIDGET,$Idx)
    set W     [lindex $WInfo 0]
    set WL    [lindex $WInfo 1]
  } else {
    # Esta en GidData pero no visible
    set W ""
    set WL ""
  }
  
  # Ocultar el control
  
  if { $W != "" } {
    grid remove $W
    if { $WL != "" } {
      grid remove $WL
    }
  }
  
  switch $GidData($TYPE,TYPE,$Idx) {
    "UNITS" {
      set CallSet DepSetScalar
    }
    "\#N\#" {
      #set CallSet DepSetVarValue
      set CallSet DepSetScalar
    }
    default {
      set CallSet DepSetScalar
    }
  }
  
  if { [string toupper $NewValue] ne "#CURRENT#" } {
    eval [list $CallSet $GDN $TYPE $Idx $NewValue]
  }
  set GidData($TYPE,STATE,$Idx) hidden
}

proc DepActionCONDITION { GDN CndName state } {
    WindowMessage "Establecer la condición $CndName dentro de $GDN a $state"
}

proc DepActionTITLESTATE { GDN TYPE TITLE state } {
  upvar \#0 $GDN GidData
  
  #search for TITLE's idx
  set idx_found 0
  set _title [DWUnder2Space $TITLE]
  foreach idx [array names GidData ${TYPE},TITLE,*] {
    if [string equal $GidData($idx) $_title] {
      set idx_found 1
      break
    }
  }
  if !$idx_found {
    WindowMessage "TITLESTATE: TITLE '$TITLE 'not found "
    return
  }
  
  #verifico si el book esta visible!!!
  
  if $GidData($TYPE,VISIBLE) {
    if [catch [list optionbar $GidData(OPTIONBAR) state [DWUnder2Space $TITLE] $state] result] {
      WindowMessage "TITLESTATE: $result"
    }
  }
  regsub ",TITLE," $idx ",TITLESTATE," idx
  
  set GidData($idx) $state
}

namespace eval ClassInfo {
    namespace export  GetTop GetClass HasMembers
    
    variable Info

    array set Info {
	   classes {conditions materials intvdata gendata}
	   CND conditions
	   MAT materials
	   ID  intvdata
	   PD  gendata
	   conditions CND
	   materials  MAT
	   intvdata   ID
	   gendata    PD
	   conditions,hm  1
	   materials,hm   1
	   intvdata,hm    1
	   gendata,hm     0
    }
    
    proc GetClass { t } {
	   variable Info

	   if [catch {set class $Info($t)}] {
	       error "Unknown top class $t"
	   }
	   return $class
    }
    
    proc GetTop { c } {
	   variable Info

	   if [catch {set top $Info($c)}] {
	       error "Unknown data class $c"
	   }
	   return $top
    }
    proc HasMembers { c } {
	   variable Info

	   if [catch {set hm $Info($c,hm)}] {
	       error "Unknown data class $c"
	   }
	   return $hm
    }
    proc IsValidClass { c } {
	   variable Info

	   return [expr [lsearch -exact $Info(classes) $c] != -1]
    }
}

# si op == set (tail args 2) = (newvalue state)


# -------------------------------------------------------------------
#  Procedure _GidAccessValue:
#   
#      Procedimiento de acceso set/get a una QUESTION perteneciente a 
#      un "conjunto de datos". El argumento gdnCaller indica quien 
#      invoca (actualmente no se utiliza). op = {set|get} indica la
#      operacion a realizar. Los argumentos siguientes referencian la
#      propiedad a acceder, tienen la forma {class prop value [state]}
#      o {class member prop value [state]}
#
#      ejemplo:
#      
#      material steel density  10 normal
#
#      gendata Identifier -ANY- disabled
#
# -------------------------------------------------------------------

proc _GidAccessValue { gdnCaller op args } {

  set class  [lindex $args 0]
  set member [lindex $args 1]
  set state  [lindex $args end]
  
  set top [ClassInfo::GetTop $class]
  set hm  [ClassInfo::HasMembers $class]
  
  #lista de variables del tipo que me piden: CND, MAT, ID, PD
  #que estan actualmente abiertas.
  set listGDN [info globals GD_${top}_*]
  
  set idx -1
  
  foreach GDN $listGDN {
    
    upvar \#0 $GDN GidData
    
    set found 0
    if { $top == "ID" } {
      if [IsInteger $member] {
        set intv $member
        set property [lindex $args 2]
      } else {
        set intv [DWGetActiveInterval]
        set property $member
      }
      if { $intv == $GidData(ID,currentinterval) } {
        set found 1
        set TYPE ID
      }
    } else {
      # top = CND, MAT o  PRB
      if {$hm} {
        # CND, MAT
        
        set stridx [array names GidData $top,$member*,VALUE,1]
        if {[llength $stridx]} {
          set found 1
          regsub ",VALUE,1" $stridx "" TYPE
          set property [lindex $args 2]
        }
      } else {
        # PRB
        if {[info exists GidData($top,VALUE,1)]} {
          set found 1
          set TYPE $top
          set property $member
        }
      }
    }
    if {$found} {
      if [catch {set idx $GidData($TYPE,LABEL,$property)}] {
        # La propiedad no esta etiquetada,
        # entonces la intento etiquetar
        if { [set idx [LabelField $GDN $TYPE $property]] != -1 } {
          # pude etiquetar ==> property esta en GidData
          break
        }
      } else {
        break
      } 
    }
  }
  
  if { $idx == -1 } {
    # no esta en ningun GidData, por tanto
    # lo paso a GiD.
    
    if { [string equal $op "set"] } {
      # elimino el arg state
      if {[lsearch "normal hidden disabled" $state]!=-1} {
        set args [lrange $args 0 end-1]
      }
      return [eval GiD_AccessValue $op $args]
    } else {
      return [eval GiD_AccessValue $op $args]
    }
  }
  # the property is in some book visible.
  if { $op == "set" } {
    if {[lsearch "normal hidden disabled" $state]==-1} {
      set state normal
      set newValue [lindex $args end]
    } else {
      set newValue [lindex $args end-1]
    }
    switch $state {
      normal {
        DepActionRESTORE $GDN $TYPE $idx $newValue
      }
      hidden {
        DepActionHIDE $GDN $TYPE $idx $newValue
      }
      disabled {
        DepActionSET $GDN $TYPE $idx $newValue
      }
    }
  } else {
    set newValue [Field2String $GDN $TYPE $idx]
  }
  return $newValue
}
