uumlxmiexportdoc.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

     //xmi.id="' + GetURIOf(Ident, TheClass, InFile) +
     //          XMIIDSeparatorIdentifier + Parameter.Name '"
     Write(  '<Foundation.Core.Parameter>', icOpened);

     Write(   '<Foundation.Core.ModelElement.name>' + Param.Name +
              '</Foundation.Core.ModelElement.name>');

     //has a default value?
     if Param.DefaultValue <> '' then
      begin
       //open tags for the default value and for the expression
       Write(   '<Foundation.Core.Parameter.defaultValue>', icOpened);
       //xmi.id="' + GetURIOf(Ident, TheClass, InFile) +
       //          XMIIDSeparatorIdentifier + Parameter.Name '.Default"
       Write(    '<Foundation.Data_Types.Expression>', icOpened);
       //language of the expression is pascal (more general than Delphi)
       Write(     '<Foundation.Data_Types.Expression.language>Pascal</Foundation.Data_Types.Expression.language>');
       //write the expression
       Write(     '<Foundation.Data_Types.Expression.body>' +
                  HandleRawText(Param.DefaultValue) +
                  '</Foundation.Data_Types.Expression.body>');
       Write(    '</Foundation.Data_Types.Expression>', icClosed);
       Write(   '</Foundation.Core.Parameter.defaultValue>', icClosed);
      end;

     //write the kind of the parameter
     Write(   '<Foundation.Core.Parameter.kind xmi.value="' +
              ParamKind[Param.Kind] + '"/>');
{
     Write(   '<Foundation.Core.Parameter.behavioralFeature>', icOpened);
     Write(    '<Foundation.Core.BehavioralFeature xmi.idref="'' +
               GetURIOf(Ident, TheClass, InFile) + '"/>');
     Write(   '</Foundation.Core.Parameter.behavioralFeature>', icClosed);
}

     //and write its type
     WriteTypeReference(Param.ParamType, 'Foundation.Core.Classifier',
                                         'Foundation.Core.Parameter.type');

     Write(  '</Foundation.Core.Parameter>', icClosed);
    end; //for i := 0 to Ident.Params.Count - 1

   Write( '</Foundation.Core.BehavioralFeature.parameter>', icClosed);
  end; //if (Ident.FuncKind = fkFunction) or not Ident.Params.IsEmpty

 Write('</Foundation.Core.Operation>', icClosed);
end;


{Writes the field or property.
~param Ident      the identifier of the field or attribute to write
~param IsProperty if it is a property instead of a field }
procedure TUMLXMIExportDoc.WriteAttribute(Ident: TIdentifier;
                                          IsProperty: Boolean);
var       ItsType         :TType;        //type of the attribute
begin
 //start the tag of the attribute and its name and scope
 Write('<Foundation.Core.Attribute xmi.id="' + GetURIOf(Ident) + '">',
       icOpened);
 Write( '<Foundation.Core.ModelElement.name>' + Ident.Name +
        '</Foundation.Core.ModelElement.name>');
 WriteScope(Ident.Scope);

 //is it is a property with only read access, write this
 if IsProperty and TProperty(Ident).IsReadOnly then
  Write('<Foundation.Core.StructuralFeature.changeability xmi.value="frozen"/>');
 //else could write "changeable"

{
 Write( '<Foundation.Core.Feature.owner>', icOpened);
 Write(  '<Foundation.Core.Classifier xmi.idref="' +
         GetURIOf(TheClass, nil, InFile) + '"/>');
 Write( '</Foundation.Core.Feature.owner>', icClosed);
}


 //get the type of the attribute
 assert((Ident is TField) or (Ident is TProperty));
 if Ident is TField then
  ItsType := TField(Ident).FieldType
 else
  ItsType := TProperty(Ident).PropertyType;

 //and write it
 WriteTypeReference(ItsType, 'Foundation.Core.Classifier',
                             'Foundation.Core.StructuralFeature.type');

 Write('</Foundation.Core.Attribute>', icClosed);
end;





{Writes the class or interface.
~param Ident       the record-like type to write
~param IsInterface if it should be handled like an interface }
procedure TUMLXMIExportDoc.WriteClass(Ident: TRecordType;
                                      IsInterface: Boolean);

 {Write references to implemented interfaces of the class. }
 procedure WriteImplementedInterfaces;
 var       i       :Integer;          //counter through all interfaces
           Interf  :TIdentifier;      //each interface implemented by the class
 begin
  //start list of implemented interfaces
  Write( '<Foundation.Core.ModelElement.clientDependency>', icOpened);

  for i := 0 to Ident.Implementing.Count - 1 do  //for each interface
   begin
    Interf := Ident.Implementing[i];               //get the alias
    assert(Interf is TIdentType);

    //get the interface
    Interf := TIdentType(Interf).GetFinalType;

    if (Interf is TRecordType) and                 //interface known
       (TRecordType(Interf).Kind = rkInterface) and  //and correct
       //and it knows that this class implements it (also need a reference
       TRecordType(Interf).Implementing.IsIn(Ident) and //there)
       not DoNotDocumentIdentifier(Interf) then         //and documented?
     //write reference to the tag defining the implementing
     Write(  '<Foundation.Core.Abstraction xmi.idref="' +
             XMIIDPrefixAbstraction +
             GetURIOf(Interf, nil, False) +
             XMIIDDoubleSeparator + GetURIOf(Ident, nil, False) +
             '"/>');
   end;

  Write( '</Foundation.Core.ModelElement.clientDependency>', icClosed);
 end;

 {Write references to implementing classes of the interface. }
 procedure WriteImplementingClasses;
 var       i           :Integer;       //counter through all classes
{$IFOPT C+}
           j           :Integer;       //another counter
{$ENDIF}
           TheClass    :TIdentifier;   //identifier in the class or used by it
 begin
  //start list of implementing classes
  Write( '<Foundation.Core.ModelElement.supplierDependency>', icOpened);

  for i := 0 to Ident.Implementing.Count - 1 do  //for each class
   begin
    TheClass := Ident.Implementing[i];             //get the class
    assert(TheClass is TRecordType);
    assert(TRecordType(TheClass).Kind = rkClass);

{$IFOPT C+}
    //check if the interface is registered with the class
    j := TRecordType(TheClass).Implementing.Count - 1;
    while (j >= 0) and
          (TIdentType(TRecordType(TheClass).Implementing[j]).GetFinalType <>
           Ident) do
     dec(j);
    assert(j >= 0);
{$ENDIF}

    if not DoNotDocumentIdentifier(TheClass) then //documented?
     //write reference to the tag defining the implementing
     Write(  '<Foundation.Core.Abstraction xmi.idref="' +
             XMIIDPrefixAbstraction + GetURIOf(Ident, nil, False) +
             XMIIDDoubleSeparator + GetURIOf(TheClass, nil, False) + '"/>');
   end;

  Write( '</Foundation.Core.ModelElement.supplierDependency>', icClosed);
 end;

 {Write a reference to the parent class. }
 procedure WriteGeneralization;
 var       Parent     :TIdentifier;   //the parent type
 begin
  //get the real parent type
  Parent := Ident.IdentParent.GetFinalType;
  //parent is known and documented?
  if assigned(Parent) and not DoNotDocumentIdentifier(Parent) then
   begin
    //write the tag to define the parent class
    Write( '<Foundation.Core.GeneralizableElement.generalization>', icOpened);

    assert(Parent is TRecordType);
    assert(TRecordType(Parent).Kind = Ident.Kind);
    assert(TRecordType(Parent).Children.IsIn(Ident));

    //write reference to the tag defining the parent relationship
    Write(  '<Foundation.Core.Generalization xmi.idref="' +
            XMIIDPrefixGeneralization + GetURIOf(Ident, nil, False) + '"/>');

    Write( '</Foundation.Core.GeneralizableElement.generalization>', icClosed);
   end;
 end;

 {Write references to the subclasses. }
 procedure WriteSpecializations;
 var       i          :Integer;        //counter through all subclasses
           SubClass   :TIdentifier;    //class inheriting from current class
 begin
  //write the tag for the list of subclasses
  Write( '<Foundation.Core.GeneralizableElement.specialization>', icOpened);

  for i := 0 to Ident.Children.Count - 1 do //for each subclass
   begin
    SubClass := Ident.Children[i];            //get it

    assert(SubClass is TRecordType);
    assert(TRecordType(SubClass).Kind = Ident.Kind);
    assert(assigned(TRecordType(SubClass).IdentParent));
    assert(assigned(TRecordType(SubClass).IdentParent.GetFinalType()));
    assert(TRecordType(SubClass).IdentParent.GetFinalType = Ident);

    if not DoNotDocumentIdentifier(SubClass) then //documented?
     //write reference to the tag defining the subclass relationship
     Write(  '<Foundation.Core.Generalization xmi.idref="' +
             XMIIDPrefixGeneralization +
             GetURIOf(SubClass, nil, False) + '"/>');
   end;

  Write( '</Foundation.Core.GeneralizableElement.specialization>', icClosed);
 end;


 {Write tags to express the relationship of interfaces implemented by this
  class. }
 procedure WriteImplementsTags;
 var       i         :Integer;        //counter through all interfaces
           Interf    :TIdentifier;    //each interface implemented by the class
 begin
  for i := 0 to Ident.Implementing.Count - 1 do  //for each interface
   begin
    Interf := Ident.Implementing[i];               //get it
    assert(Interf is TIdentType);

    //get the real interface
    Interf := TIdentType(Interf).GetFinalType;

    if (Interf is TRecordType) and                 //check if valid
       (TRecordType(Interf).Kind = rkInterface) and
       TRecordType(Interf).Implementing.IsIn(Ident) and
       not DoNotDocumentIdentifier(Interf) then      //documented?
     begin
      //write the tag for the relationship
      Write('<Foundation.Core.Abstraction xmi.id="' +
            XMIIDPrefixAbstraction + GetURIOf(Interf, nil, False) +
            XMIIDDoubleSeparator + GetURIOf(Ident, nil, False) + '">',
            icOpened);

      //write a reference to this implementing class
      Write( '<Foundation.Core.Dependency.client>', icOpened);
      Write(  '<Foundation.Core.ModelElement xmi.idref="' +
              GetURIOf(Ident) + '"/>');
      Write( '</Foundation.Core.Dependency.client>', icClosed);

      //write a reference to the implemented interface
      Write( '<Foundation.Core.Dependency.supplier>', icOpened);
      Write(  '<Foundation.Core.ModelElement xmi.idref="' +
              GetURIOf(Interf) + '"/>');
      Write( '</Foundation.Core.Dependency.supplier>', icClosed);

      Write('</Foundation.Core.Abstraction>', icClosed);
     end;
   end;
 end;


 {Write tag to express the relationship of this class being a subclass of
  another class. }
 procedure WriteGeneralizationTag;
 var       Parent     :TIdentifier;           //the real parent type
 begin
  //get the real parent type
  Parent := Ident.IdentParent.GetFinalType;
  //parent class known and documented?
  if assigned(Parent) and not DoNotDocumentIdentifier(Parent) then
   begin
    assert(Parent is TRecordType);
    assert(TRecordType(Parent).Kind = Ident.Kind);
    assert(TRecordType(Parent).Children.IsIn(Ident));

    //write the tag for the relationship
    Write('<Foundation.Core.Generalization xmi.id="' +
          XMIIDPrefixGeneralization + GetURIOf(Ident, nil, False) +
          '">', icOpened);

    //write reference to this (sub-)class
    Write( '<Foundation.Core.Generalization.child>', icOpened);
    Write(  '<Foundation.Core.GeneralizableElement xmi.idref="' +
            GetURIOf(Ident) + '"/>');
    Write( '</Foundation.Core.Generalization.child>', icClosed);

    //write reference to the parent class
    Write( '<Foundation.Core.Generalization.parent>', icOpened);
    Write(  '<Foundation.Core.GeneralizableElement xmi.idref="' +
            GetURIOf(Parent) + '"/>');
    Write( '</Foundation.Core.Generalization.parent>', icClosed);

    Write('</Foundation.Core.Generalization>', icClosed);
   end;
 end;

          //postfix of the XMI tag for the class or interface
const     XMIRecType: array[Boolean] of String = ('Class', 'Interface');
var       i         :Integer;         //counter through the members
          Member    :TIdentifier;     //members of the class
          Members   :TIdentifierList; //sorted list of identifiers
begin
 //write the tag for the class/interface and its name and scope
 Write('<Foundation.Core.' + XMIRecType[IsInterface] +
       ' xmi.id="' + GetURIOf(Ident) + '">', icOpened);
 Write( '<Foundation.Core.ModelElement.name>' + Ident.Name +
        '</Foundation.Core.ModelElement.name>');
 WriteScope(Ident.Scope);


 //if it is an abstract class, write that
 if Ident.IsAbstract then
  Write( '<Foundation.Core.GeneralizableElement.isAbstract xmi.value="true"/>');



 //is a class and implements some interfaces?
 if not IsInterface and not Ident.Implementing.IsEmpty and
    not (rkInterface in FNoXMIClasses) then
  WriteImplementedInterfaces;

//Foundation.Core.ModelElement.clientDependency   for Usage

 //is an interface and implemented by some classes?
 if IsInterface and not Ident.Implementing.IsEmpty and
    not (rkClass in FNoXMIClasses) then
  WriteImplementingClasses;

//Foundation.Core.ModelElement.supplierDependency   for Usage

 //if it has a parent, write the generalization
 if assigned(Ident.IdentParent) then
  WriteGeneralization;


 //if it is subclassed, write the specializations
 if not Ident.Children.IsEmpty then
  WriteSpecializations;









 if not Ident.IdentList.IsEmpty then   //has some members?
  begin
   Members := TIdentifierList.Create;    //create list to sort the members
   try
     for i := 0 to Ident.IdentList.Count - 1 do //copy all members to the list
      begin
       Member := Ident.IdentList[i];               //get it
       if not DoNotDocumentIdentifier(Member) then //documented?
        Members.AddIdent(Member);                    //add it to sorted list
      end;

     if not Members.IsEmpty then         //some members documented?
      begin
       Members.Sort;                       //and sort the list

       //write tag for the list of members
       Write( '<Foundation.Core.Classifier.feature>', icOpened);

       for i := 0 to Members.Count - 1 do  //for each member
        begin
         Member := Members[i];               //get it
         assert((Member is TField) or (Member is TFunction) or
                (Member is TProperty));
         if Member is TFunction then         //write it
          WriteOperation(TFunction(Member))
         else
          WriteAttribute(Member, Member is TProperty);
        end;

       //end the list fo members
       Write( '</Foundation.Core.Classifier.feature>', icClosed);
      end;

   finally
    Members.RemoveAll(False);            //don't free the members
    Members.Free;                        //free the list
   end;
  end;



 //close the tag of the class/interface
 Write('</Foundation.Core.' + XMIRecType[IsInterface] + '>', icClosed);







 //is a class and implements some interfaces?
 if not IsInterface and not Ident.Implementing.IsEmpty and
    not (rkInterface in FNoXMIClasses) then
  WriteImplementsTags;

 //if it has a parent class
 if assigned(Ident.IdentParent) then
  WriteGeneralizationTag;
end;



{Writes the data type.
~param Ident  the identifier of the type }
procedure TUMLXMIExportDoc.WriteDataType(Ident: TType);
begin
 //write the tag for the simple type and its name and scope
 Write('<Foundation.Core.DataType xmi.id="' + GetURIOf(Ident) + '">',
       icOpened);
 Write( '<Foundation.Core.ModelElement.name>' + Ident.Name +
        '</Foundation.Core.ModelElement.name>');
 WriteScope(Ident.Scope);
 Write('</Foundation.Core.DataType>', icClosed);
end;



{Writes all types in the file.
~param InFile the file whose types should be written }
procedure TUMLXMIExportDoc.WriteTypes(InFile: TPascalFile);
var       List            :TIdentifierList; //to sort types alphabetically
          i               :Integer;         //counter through the types
          Ident           :TIdentifier;     //each type
begin
 List := TIdentifierList.Create;            //create list for sorting types
 try
   for i := 0 to InFile.Idents.Count - 1 do //for each identifier
    begin