# Commands to generate xml tags for instrument description file
package require tdom;

# To add a new element in the instrument xml file do the following,
# 1. Add the element name to the tags list
# 2. Modify the hdbMakeXML procedures that should use the new element

# This is a list of the xml tags in an instrument xml file.
set tags [list part device property val];
foreach tag $tags {dom createNodeCmd elementNode $tag}
dom createNodeCmd textNode text_node;

# hmake path priv dataType [length]
proc hmake {hpath priv dataType args} {
  global doc root part;
  set parent $root;
  foreach pid [split [string trimleft $hpath /] /] {
    set node [eval "$parent selectNodes {//part\[@id='$pid'\]}"];
    if {$node == ""} {
      set child [$doc createElement part];
      $child setAttribute id $pid;
      $parent appendChild $child;
      set parent $child;
    } else {
      set parent $node;
    }
  }
}

proc instrumentXML {instrument} {
  global doc root
  set doc [dom createDocumentNS commonj.sdo sdo:datagraph];
  set root [$doc createElementNS http://www.psi.ch/sics/hipadaba hipadaba:Instrument];
  $root setAttribute label $instrument;
  [$doc documentElement] appendChild $root;
}

# Return node corresponding to hpath
proc hpathNode {hpath} {
  global root;
  set partsList [split [string trimleft $hpath /] /];
# make selectNodes argument
  set snarg "{/";
  foreach pid $partsList {
    set p [subst -nocommand {/part[@id='$pid']}];
    set snarg [append snarg $p];
  }
  set snarg [append snarg "}"];
  set node [eval "$root selectNodes $snarg"];
  return $node;
}

# This code is shared by Motor and ConfigurableVirtualMotor objects.
set hdbMakeAnyMotorXML {
  set node [hpathNode $hpath];
  if {$node == ""} {
    clientput "$hpath doesn't exist" error;
    return 1;
  }
  $node appendFromScript {
    foreach {ppName ppPriv ppType ppValue} $primaryProperty {}
    device id $treename deviceType $deviceType primaryProperty $ppName {
      property privilege $ppPriv dataType $ppType id $ppName {
        foreach v $ppValue { val {text_node $v}}
      }
      foreach {name priv type value} $parList {
        property privilege $priv dataType $type id $name {
          foreach v $value { val {text_node $v}}
      }

      }
    }
  }
}

proc ::deviceType::Motor::hdbMakeXML  {hpath treename sicsname} {
  variable parList;
  variable deviceType;
  variable primaryProperty;
  global hdbMakeAnyMotorXML;
  eval $hdbMakeAnyMotorXML;
}

proc ::deviceType::ConfigurableVirtualMotor::hdbMakeXML {hpath treename sicsname} {
  variable parList;
  variable deviceType;
  variable primaryProperty;
  global hdbMakeAnyMotorXML;
  eval $hdbMakeAnyMotorXML;
}

proc ::deviceType::SingleCounter::hdbMakeXML {hpath treename sicsname} {
  variable parList;
  variable deviceType;
  variable primaryProperty;
  set node [hpathNode $hpath];
  if {$node == ""} {
    clientput "$hpath doesn't exist" error;
    return 1;
  }
  $node appendFromScript {
    foreach {ppName ppPriv ppType ppValue} $primaryProperty {}
    device id $treename deviceType $deviceType primaryProperty $ppName {
      property privilege $ppPriv dataType $ppType id $ppName {
        foreach v $ppValue { val {text_node $v}}
      }
      foreach {name priv type value} $parList {
        property privilege $priv dataType $type id $name {
          foreach v $value { val {text_node $v}}
        }
      }
    }
  }
}

proc makeHdbMotor {hpath treename sicsname} {
  ::deviceType::Motor::hdbMakeXML  $hpath $treename $sicsname;
}

proc makeHdbVirtMotor {hpath treename sicsname} {
  ::deviceType::ConfigurableVirtualMotor::hdbMakeXML  $hpath $treename $sicsname;
}

proc makeHdbCounter {hpath treename sicsname} {
  ::deviceType::SingleCounter::hdbMakeXML  $hpath $treename $sicsname;
}

proc makeHdbHM {hpath treename sicsname} {
  global hmParList;
  set node [hpathNode $hpath];
  if {$node == ""} {
    clientput "$hpath doesn't exist" error;
    return 1;
  }
  $node appendFromScript {
    device id $treename {
      foreach {name priv type value} $hmParList {
        property privilege $priv dataType $type id $name {
          foreach v $value { val {text_node $v}}
        } 
      }
    }
  }
}