unit ExtCore;

{******************************************************************************}
{                                                                              }
{                StarUML - The Open Source UML/MDA Platform.                   }
{                                                                              }
{              Copyright (C) 2002-2005 - Plastic Software, Inc.                }
{                                                                              }
{                                                                              }
{ This program is free software; you can redistribute it and/or modify it      }
{ under the terms of the GNU General Public License as published by the Free   }
{ Software Foundation; either version 2 of the License, or (at your option)    }
{ any later version.                                                           }
{                                                                              }
{ This program is distributed in the hope that it will be useful, but WITHOUT  }
{ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        }
{ FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for     }
{ more details.                                                                }
{                                                                              }
{ You should have received a copy of the GNU General Public License along with }
{ this program; if not, write to the Free Software Foundation, Inc., 51        }
{ Franklin St, Fifth Floor, Boston, MA 02110-1301 USA                          }
{                                                                              }
{ Linking StarUML statically or dynamically with other modules is making a     }
{ combined work based on StarUML. Thus, the terms and conditions of the GNU    }
{ General Public License cover the whole combination.                          }
{                                                                              }
{ In addition, as a special exception, Plastic Software give you permission to }
{ combine StarUML program with free software programs or libraries that are    }
{ released under the GNU LGPL/Mozilla/Apache/BSD and with code included in the }
{ standard release of ExpressBar, ExpressNavBar, ExpressInspector,             }
{ ExpressPageControl, ProGrammar, NextGrid under the commercial license (or    }
{ modified versions of such code, with unchanged license). You may copy and    }
{ distribute such a system following the terms of the GNU GPL for StarUML and  }
{ the licenses of the other code concerned, provided that you include the      }
{ source code of that other code when and as the GNU GPL requires distribution }
{ of source code. Plastic Software also give you permission to combine StarUML }
{ program with dynamically linking plug-in (or add-in) programs that are       }
{ released under the GPL-incompatible and proprietary license.                 }
{                                                                              }
{ Note that people who make modified versions of StarUML are not obligated to  }
{ grant this special exception for their modified versions; it is their choice }
{ whether to do so. The GNU General Public License gives permission to release }
{ a modified version without this exception; this exception also makes it      }
{ possible to release a modified version which carries forward this exception. }
{******************************************************************************}

interface

uses
  BasicClasses, Core, Classes, Graphics, SysUtils, XMLDoc, XMLIntf, NxMgr;

const
  EXT_DIR = 'modules';
  PROFILE_EXTENSION = 'prf';
  ICON_EXTENSION = 'ico';

type
  // Forward Declarations
  PConstraint = class;
  PTaggedValue = class;
  PStereotype = class;
  PTagDefinition = class;
  PTagDefinitionSet = class;
  PDiagramType = class;
  PElementPrototype = class;
  PModelPrototype = class;
  PPalette = class;
  PProfile = class;
  PExtensibleModel = class;
  PDataType = class;

  // Parametrized collections of ExtCore types
  PExtensibleModelOrderedSet = POrderedSet<PExtensibleModel>;
  PConstraintOrderedSet = POrderedSet<PConstraint>;
  PTaggedValueOrderedSet = POrderedSet<PTaggedValue>;
  PElementPrototypeOrderedSet = POrderedSet<PElementPrototype>;
  PModelPrototypeOrderedSet = POrderedSet<PModelPrototype>;
  PDiagramTypeOrderedSet = POrderedSet<PDiagramType>;
  PPaletteOrderedSet = POrderedSet<PPalette>;
  PStereotypeOrderedSet = POrderedSet<PStereotype>;
  PTagDefinitionOrderedSet = POrderedSet<PTagDefinition>;
  PTagDefinitionSetOrderedSet = POrderedSet<PTagDefinitionSet>;
  PDataTypeOrderedSet = POrderedSet<PDataType>;
  PProfileOrderedSet = POrderedSet<PProfile>;

  // Enumerations
  PTagTypeKind = (tkInteger, tkBoolean, tkString, tkReal, tkEnumeration, tkReference, tkCollection);
  PDragTypeKind = (dkRect, dkLine);

  // Exception
  EProfileNotFound = class(Exception);
  ETagDefinitionNotFound = class(Exception);
  EInvalidTaggedValueType = class(Exception);
  EInvalidProfileFileFormat = class(Exception);
  EUnableSetTaggedValue = class(Exception);
  ECannotExcludeProfile = class(Exception);

  // Event Types
  PProfileEvent = procedure(Sender: TObject; AProfileName: string) of object;

  // PExtensibleModel
  PExtensibleModel = class(PModel)
  private
    FStereotypeProfile: string;
    FStereotypeName: string;
    FConstraints: PConstraintOrderedSet;
    FTaggedValues: PTaggedValueOrderedSet;
    FReferencingTags: PTaggedValueOrderedSet;
    procedure SetStereotypeProfile(Value: string);
    procedure SetStereotypeName(Value: string);
    function GetConstraint(Index: Integer): PConstraint;
    function GetConstraintCount:Integer;
    function GetTaggedValue(Index: Integer): PTaggedValue;
    function GetTaggedValueCount:Integer;
    function GetReferencingTag(Index: Integer): PTaggedValue;
    function GetReferencingTagCount: Integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Accept(Visitor: PVisitor); override;
    function GetStereotype: PStereotype;
    procedure SetStereotype(Name: string); overload;
    procedure SetStereotype(Profile: string; Name: string); overload;
    procedure ClearConstraints;
    procedure AddConstraint(AConstraint: PConstraint);
    procedure RemoveConstraint(AConstraint: PConstraint);
    procedure InsertConstraint(Index: Integer; AConstraint: PConstraint);
    procedure DeleteConstraint(Index: Integer);
    function IndexOfConstraint(AConstraint: PConstraint): Integer;
    function GetConstraintByGuid(AGuid: string): PConstraint;
    procedure ClearTaggedValues;
    procedure AddTaggedValue(ATaggedValue: PTaggedValue);
    procedure RemoveTaggedValue(ATaggedValue: PTaggedValue);
    procedure InsertTaggedValue(Index: Integer; ATaggedValue: PTaggedValue);
    procedure DeleteTaggedValue(Index: Integer);
    function IndexOfTaggedValue(ATaggedValue: PTaggedValue): Integer;
    procedure ClearReferencingTags;
    procedure AddReferencingTag(ATaggedValue: PTaggedValue);
    procedure RemoveReferencingTag(ATaggedValue: PTaggedValue);
    procedure InsertReferencingTag(Index: Integer; ATaggedValue: PTaggedValue);
    procedure DeleteReferencingTag(Index: Integer);
    function IndexOfReferencingTag(ATaggedValue: PTaggedValue): Integer;
    function FindTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): PTaggedValue;
    function QueryDataTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): string;
    function QueryReferenceTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): PExtensibleModel;
    function IsApplicableTagDefinition(Profile: string; TagDefinitionSet: string; Name: string): Boolean;
    function MOF_GetAttribute(Name: string): string; override;
    procedure MOF_SetAttribute(Name, Value: string); override;
    procedure MOF_AddCollectionItem(Name: string; Value: PElement); override;
    procedure MOF_RemoveCollectionItem(Name: string; Value: PElement); override;
    procedure MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement); override;
    procedure MOF_DeleteCollectionItem(Name: string; Index: Integer); override;
    procedure MOF_ClearCollection(Name: string); override;
    function MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer; override;
    function MOF_GetCollectionItem(Name: string; Index: Integer): PElement; override;
    function MOF_GetCollectionCount(Name: string): Integer; override;
    property StereotypeProfile: string read FStereotypeProfile write SetStereotypeProfile;
    property StereotypeName: string read FStereotypeName write SetStereotypeName;
    property Constraint[Index: Integer]: PConstraint read GetConstraint;
    property ConstraintCount: Integer read GetConstraintCount;
    property Constraints: PConstraintOrderedSet read FConstraints;
    property TaggedValue[Index: Integer]: PTaggedValue read GetTaggedValue;
    property TaggedValueCount: Integer read GetTaggedValueCount;
    property TaggedValues: PTaggedValueOrderedSet read FTaggedValues;
    property ReferencingTags[Index: Integer]: PTaggedValue read GetReferencingTag;
    property ReferencingTagCount: Integer read GetReferencingTagCount;
  end;

  // PConstraint
  PConstraint = class(PElement)
  private
    FName: string;
    FBody: string;
    FConstrainedModel: PExtensibleModel;
    procedure SetName(Value: string);
    procedure SetBody(Value: string);
    procedure SetConstrainedModel(Value: PExtensibleModel);
  public
    constructor Create; override;
    function GetContainingDocument: PDocument; override;
    function MOF_GetAttribute(Name: string): string; override;
    procedure MOF_SetAttribute(Name, Value: string); override;
    function MOF_GetReference(Name: string): PElement; override;
    procedure MOF_SetReference(Name: string; Value: PElement); override;
    property ConstrainedModel: PExtensibleModel read FConstrainedModel write SetConstrainedModel;
    property Name: string read FName write SetName;
    property Body: string read FBody write SetBody;
  end;

  // PTaggedValue
  PTaggedValue = class(PElement)
  private
    FProfileName: string;
    FTagDefinitionSetName: string;
    FName: string;
    FDataValue: string;
    FTaggedModel: PExtensibleModel;
    FReferenceValues: PExtensibleModelOrderedSet;
    procedure SetProfileName(Value: string);
    procedure SetTagDefinitionSetName(Value: string);
    procedure SetName(Value: string);
    procedure SetTaggedModel(Value: PExtensibleModel);
    function GetDataValue: string;
    procedure SetDataValue(Value: string);
    function GetReferenceValueCount: Integer;
    function GetReferenceValue(Index: Integer): PExtensibleModel;
  public
    constructor Create; override;
    destructor Destroy; override;
    function GetTagDefinition: PTagDefinition;
    function GetTagDefinitionSet: PTagDefinitionSet;
    function GetProfile: PProfile;
    function GetContainingDocument: PDocument; override;
    procedure ClearReferenceValues;
    procedure AddReferenceValue(Value: PExtensibleModel);
    procedure RemoveReferenceValue(Value: PExtensibleModel);
    procedure InsertReferenceValue(Index: Integer; Value: PExtensibleModel);
    procedure DeleteReferenceValue(Index: Integer);
    function IndexOfReferenceValue(Value: PExtensibleModel): Integer;
    function MOF_GetAttribute(Name: string): string; override;
    procedure MOF_SetAttribute(Name, Value: string); override;
    function MOF_GetReference(Name: string): PElement; override;
    procedure MOF_SetReference(Name: string; Value: PElement); override;
    procedure MOF_AddCollectionItem(Name: string; Value: PElement); override;
    procedure MOF_RemoveCollectionItem(Name: string; Value: PElement); override;
    procedure MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement); override;
    procedure MOF_DeleteCollectionItem(Name: string; Index: Integer); override;
    procedure MOF_ClearCollection(Name: string); override;
    function MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer; override;
    function MOF_GetCollectionItem(Name: string; Index: Integer): PElement; override;
    function MOF_GetCollectionCount(Name: string): Integer; override;
    property TaggedModel: PExtensibleModel read FTaggedModel write SetTaggedModel;
    property ProfileName: string read FProfileName write SetProfileName;
    property TagDefinitionSetName: string read FTagDefinitionSetName write SetTagDefinitionSetName;
    property Name: string read FName write SetName;
    property DataValue: string read GetDataValue write SetDataValue;
    property ReferenceValueCount: Integer read GetReferenceValueCount;
    property ReferenceValue[Index: Integer]: PExtensibleModel read GetReferenceValue;
    property ReferenceValues: PExtensibleModelOrderedSet read FReferenceValues;
  end;

  // PTagDefinition
  PTagDefinition = class(BasicClasses.PObject)
  private
    FName: string;
    FTagType: PTagTypeKind;
    FReferenceType: string;
    FDefaultValue: string;
    FLock: Boolean;
    FTagDefinitionSet: PTagDefinitionSet;
    FLiterals: TStringList;
    function GetReferenceType: string;
    function GetLiteral(Index: Integer): string;
    function GetLiteralCount: Integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    function IndexOfLiteral(ALiteral: string): Integer;
    property Name: string read FName;
    property TagType: PTagTypeKind read FTagType;
    property ReferenceType: string read GetReferenceType;
    property DefaultValue: string read FDefaultValue;
    property Lock: Boolean read FLock;
    property LiteralCount: Integer read GetLiteralCount;
    property Literals[Index: Integer]: string read GetLiteral;
    property TagDefinitionSet: PTagDefinitionSet read FTagDefinitionSet;
  end;


  // PTagDefinitionSet
  PTagDefinitionSet = class(BasicClasses.PObject)

  private type
    TTagDefinitionSetEnumerator = class
    private
      FIndex: Integer;
      FTagDefinitionSet: PTagDefinitionSet;
    public
      constructor Create(ATagDefinitionSet: PTagDefinitionSet);
      function GetCurrent: PTagDefinition; inline;
      function MoveNext: Boolean;
      property Current: PTagDefinition read GetCurrent;
    end;

  private
    FName: string;
    FBaseClasses: TStringList;
    FTagDefinitions: PTagDefinitionOrderedSet;
    FProfile: PProfile;
    FStereotype: PStereotype;
    function GetBaseClassCount: Integer;
    function GetBaseClass(Index: Integer): string;
    function GetTagDefinitionCount: Integer;
    function GetTagDefinition(Index: Integer): PTagDefinition;
  public
    constructor Create; override;
    destructor Destroy; override;
    function FindTagDefinition(AName: string): PTagDefinition;
    function CanApplyTo(AClassName: string): Boolean;
    function GetEnumerator: TTagDefinitionSetEnumerator;
    property Name: string read FName;
    property BaseClassCount: Integer read GetBaseClassCount;
    property BaseClasses[Index: Integer]: string read GetBaseClass;
    property TagDefinitionCount: Integer read GetTagDefinitionCount;
    property TagDefinitions[Index: Integer]: PTagDefinition read GetTagDefinition;
    property Profile: PProfile read FProfile;
    property Stereotype: PStereotype read FStereotype;
  end;

  // PStereotype
  PStereotype = class(BasicClasses.PObject)
  private
    FName: string;
    FIconFile: string;
    FIconMinWidth: Integer;
    FIconMinHeight: Integer;
    FSmallIconFile: string;
    FDescription: string;
    FBaseClasses: TStringList;
    FProfile: PProfile;
    FParent: PStereotype;
    FChildren: TList;
    FTagDefinitionSet: PTagDefinitionSet;
    FImageIndex: Integer;
    FNotationExpr: PNXNotationExpr;
    FIcon: TGraphic;
    function GetBaseClassCount: Integer;
    function GetBaseClass(Index: Integer): string;
    function GetChildCount: Integer;
    function GetChild(Index: Integer): PStereotype;
    function GetDerivedTagDefinitionSet: PTagDefinitionSet;
    function GetNotationExpr: PNXNotationExpr;
    procedure LoadIconFile;
  public
    constructor Create; override;
    destructor Destroy; override;
    function CanApplyTo(AClassName: string): Boolean;
    property Name: string read FName;
    property IconFile: string read FIconFile;
    property IconMinWidth: Integer read FIconMinWidth;
    property IconMinHeight: Integer read FIconMinHeight;
    property SmallIconFile: string read FSmallIconFile write FSmallIconFile;
    property Description: string read FDescription;
    property BaseClassCount: Integer read GetBaseClassCount;
    property BaseClasses[Index: Integer]: string read GetBaseClass;
    property Profile: PProfile read FProfile;
    property Parent: PStereotype read FParent;
    property ChildCount: Integer read GetChildCount;
    property Children[Index: Integer]: PStereotype read GetChild;
    property TagDefinitionSet: PTagDefinitionSet read FTagDefinitionSet;
    property DerivedTagDefinitionSet: PTagDefinitionSet read GetDerivedTagDefinitionSet;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property NotationExpr: PNXNotationExpr read GetNotationExpr;
    property Icon: TGraphic read FIcon;
  end;

  // PDataType
  PDataType = class(BasicClasses.PObject)
  private
    FName: string;
    FProfile: PProfile;
  public
    constructor Create; override;
    property Name: string read FName;
    property Profile: PProfile read FProfile;
  end;

  // PElementPrototype
  PElementPrototype = class(BasicClasses.PObject)
  private
    FName: string;
    FDisplayName: string;
    FBaseElement: string;
    FArgument: Integer;
    FIconFile: string;
    FDragType: PDragTypeKind;
    FStereotypeName: string;
    FStereotypeDisplay: string;
    FShowExtendedNotation: Boolean;
    FModelProperties: TStringList;
    FViewProperties: TStringList;
    FTaggedValues: TStringList;
    FImageIndex: Integer;
    FProfile: PProfile;
    function GetModelPropertyCount: Integer;
    function GetModelPropertyName(Index: Integer): string;
    function GetModelPropertyValue(Index: Integer): string;
    function GetViewPropertyCount: Integer;
    function GetViewPropertyName(Index: Integer): string;
    function GetViewPropertyValue(Index: Integer): string;
    function GetTaggedValueCount: Integer;
    function GetTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string): string;
    procedure SetIconFile(AIconFile: string);
    function GetIconFile: string;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure AddModelProperty(Name: string; Value: string);
    procedure AddViewProperty(Name: string; Value: string);
    procedure AddTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string; Value: string);
    property Name: string read FName write FName;
    property DisplayName: string read FDisplayName write FDisplayName;
    property BaseElement: string read FBaseElement write FBaseElement;
    property Argument: Integer read FArgument write FArgument;
    property IconFile: string read FIconFile write SetIconFile;
    property DragType: PDragTypeKind read FDragType write FDragType;
    property StereotypeName: string read FStereotypeName write FStereotypeName;
    property StereotypeDisplay: string read FStereotypeDisplay write FStereotypeDisplay;
    property ShowExtendedNotation: Boolean read FShowExtendedNotation write FShowExtendedNotation;
    property ModelPropertyCount: Integer read GetModelPropertyCount;
    property ModelPropertyNames[Index: Integer]: string read GetModelPropertyName;
    property ModelPropertyValues[Index: Integer]: string read GetModelPropertyValue;
    property ViewPropertyCount: Integer read GetViewPropertyCount;
    property ViewPropertyNames[Index: Integer]: string read GetViewPropertyName;
    property ViewPropertyValues[Index: Integer]: string read GetViewPropertyValue;
    property TaggedValueCount: Integer read GetTaggedValueCount;
    property TaggedValues[Profile: string; TagDefinitionSet: string; TagDefinition: string]: string read GetTaggedValue;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property Profile: PProfile read FProfile;
  end;

  // PModelPrototype
  PModelPrototype = class(BasicClasses.PObject)
  private
    FName: string;
    FDisplayName: string;
    FBaseModel: string;
    FArgument: Integer;
    FIconFile: string;
    FStereotypeName: string;
    FProperties: TStringList;
    FTaggedValues: TStringList;
    FContainerModels: TStringList;
    FContainerModelStereotypes: TStringList;
    FImageIndex: Integer;
    FProfile: PProfile;
    function GetPropertyCount: Integer;
    function GetPropertyName(Index: Integer): string;
    function GetPropertyValue(Index: Integer): string;
    function GetTaggedValueCount: Integer;
    function GetTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string): string;
    function GetContainerModelCount: Integer;
    function GetContainerModel(Index: Integer): string;
    function GetContainerModelStereotype(Index: Integer): string;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure AddProperty(Name: string; Value: string);
    procedure AddTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string; Value: string);
    procedure AddContainerModel(ModelKind: string; StereotypeName: string);
    property Name: string read FName write FName;
    property DisplayName: string read FDisplayName write FDisplayName;
    property BaseModel: string read FBaseModel write FBaseModel;
    property Argument: Integer read FArgument write FArgument;
    property IconFile: string read FIconFile write FIconFile;
    property StereotypeName: string read FStereotypeName write FStereotypeName;
    property PropertyCount: Integer read GetPropertyCount;
    property PropertyNames[Index: Integer]: string read GetPropertyName;
    property PropertyValues[Index: Integer]: string read GetPropertyValue;
    property ContainerModelCount: Integer read GetContainerModelCount;
    property ContainerModels[Index: Integer]: string read GetContainerModel;
    property ContainerModelStereotypes[Index: Integer]: string read GetContainerModelStereotype;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property Profile: PProfile read FProfile;
  end;

  // PPalette
  PPalette = class(BasicClasses.PObject)
  private
    FName: string;
    FDisplayName: string;
    FPaletteItems: TStringList;
    FProfile: PProfile;
    function GetPaletteItemCount: Integer;
    function GetPaletteItem(Index: Integer): string;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure AddPaletteItem(Value: string);
    property Name: string read FName write FName;
    property DisplayName: string read FDisplayName write FDisplayName;
    property PaletteItemCount: Integer read GetPaletteItemCount;
    property PaletteItem[Index: Integer]: string read GetPaletteItem;
    property PaletteItems: TStringList read FPaletteItems;
    property Profile: PProfile read FProfile;
  end;

  // PDiagramType
  PDiagramType = class(BasicClasses.PObject)
  private
    FName: string;
    FDisplayName: string;
    FBaseDiagram: string;
    FIconFile: string;
    FAvailablePalettes: TStringList;
    FProfile: PProfile;
    FImageIndex: Integer;
    function GetAvailablePaletteCount: Integer;
    function GetAvailablePalette(Index: Integer): string;
    procedure SetIconFile(AIconFile: string);
    function GetIconFile: string;
  public
    constructor Create; override;
    destructor Destroy; override;
    property Name: string read FName write FName;
    property DisplayName: string read FDisplayName write FDisplayName;
    property BaseDiagram: string read FBaseDiagram write FBaseDiagram;
    property IconFile: string read GetIconFile write SetIconFile;
    property AvailablePaletteCount: Integer read GetAvailablePaletteCount;
    property AvailablePalette[Index: Integer]: string read GetAvailablePalette;
    property AvailablePalettes: TStringList read FAvailablePalettes;
    property Profile: PProfile read FProfile;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
  end;

  // PProfile
  PProfile = class(BasicClasses.PObject)
  private
    FName: string;
    FDisplayName: string;
    FPath: string;
    FFileName: string;
    FIconFile: string;
    FDescription: string;
    FAutoInclude: Boolean;
    FStereotypes: PStereotypeOrderedSet;
    FTagDefinitionSets: PTagDefinitionSetOrderedSet;
    FDataTypes: PDataTypeOrderedSet;
    FElementPrototypes: PElementPrototypeOrderedSet;
    FModelPrototypes: PModelPrototypeOrderedSet;
    FDiagramTypes: PDiagramTypeOrderedSet;
    FPalettes: PPaletteOrderedSet;
    function GetStereotypeCount: Integer;
    function GetStereotype(Index: Integer): PStereotype;
    function GetTagDefinitionSetCount: Integer;
    function GetTagDefinitionSet(Index: Integer): PTagDefinitionSet;
    function GetDataTypeCount: Integer;
    function GetDataType(Index: Integer): PDataType;
    function GetElementPrototypeCount: Integer;
    function GetElementPrototype(Index: Integer): PElementPrototype;
    function GetModelPrototypeCount: Integer;
    function GetModelPrototype(Index: Integer): PModelPrototype;
    function GetDiagramTypeCount: Integer;
    function GetDiagramType(Index: Integer): PDiagramType;
    function GetPaletteCount: Integer;
    function GetPalette(Index: Integer): PPalette;
  public
    constructor Create; override;
    destructor Destroy; override;
    function FindTagDefinition(ATagDefinitionSetName, AName: string): PTagDefinition;
    function FindTagDefinitionSet(AName: string): PTagDefinitionSet;
    function FindStereotype(AName: string; BaseClass: string): PStereotype;
    function FindDataType(AName: string): PDataType;
    function FindElementPrototype(AName: string): PElementPrototype;
    function FindModelPrototype(AName: string): PModelPrototype;
    function FindPrototypeNameForStereotype(AStereotypeName: string): string;
    function FindDiagramType(AName: string): PDiagramType;
    function FindPalette(AName: string): PPalette;
    property Name: string read FName;
    property DisplayName: string read FDisplayName;
    property Path: string read FPath;
    property FileName: string read FFileName;
    property IconFile: string read FIconFile;
    property Description: string read FDescription;
    property AutoInclude: Boolean read FAutoInclude;
    property StereotypeCount: Integer read GetStereotypeCount;
    property Stereotype[Index: Integer]: PStereotype read GetStereotype;
    property Stereotypes: PStereotypeOrderedSet read FStereotypes;
    property TagDefinitionSetCount: Integer read GetTagDefinitionSetCount;
    property TagDefinitionSet[Index: Integer]: PTagDefinitionSet read GetTagDefinitionSet;
    property TagDefinitionSets: PTagDefinitionSetOrderedSet read FTagDefinitionSets;
    property DataTypeCount: Integer read GetDataTypeCount;
    property DataType[Index: Integer]: PDataType read GetDataType;
    property DataTypes: PDataTypeOrderedSet read FDataTypes;
    property ElementPrototypeCount: Integer read GetElementPrototypeCount;
    property ElementPrototype[Index: Integer]: PElementPrototype read GetElementPrototype;
    property ElementPrototypes: PElementPrototypeOrderedSet read FElementPrototypes;
    property ModelPrototypeCount: Integer read GetModelPrototypeCount;
    property ModelPrototype[Index: Integer]: PModelPrototype read GetModelPrototype;
    property ModelPrototypes: PModelPrototypeOrderedSet read FModelPrototypes;
    property DiagramTypeCount: Integer read GetDiagramTypeCount;
    property DiagramType[Index: Integer]: PDiagramType read GetDiagramType;
    property DiagramTypes: PDiagramTypeOrderedSet read FDiagramTypes;
    property PaletteCount: Integer read GetPaletteCount;
    property Palette[Index: Integer]: PPalette read GetPalette;
    property Palettes: PPaletteOrderedSet read FPalettes;
  end;

  // PStereotypeTableItem
  PStereotypeTableItem = class
  private
    Stereotype: string;
    Parent: string;
    TagDefinitionSet: string;
  end;

  // PProfileReader
  PProfileReader = class
  private
    StereotypeTable: TList;
    procedure Report(Msg: string);
    procedure ClearStereotypeTable;
    function FindChild(Node: IXMLNode; Key: string): IXMLNode;
    function FindSibling(Node: IXMLNode; Key: string): IXMLNode;
    function ReadStringNodeValue(Node: IXMLNode; DefaultValue: string = ''): string;
    function ReadChildStringValue(OwnerNode: IXMLNode; Key: string; DefaultValue: string = ''): string;
    function ReadChildIntegerValue(OwnerNode: IXMLNode; Key: string; DefaultValue: Integer = 0): Integer;
    function ReadChildBooleanValue(OwnerNode: IXMLNode; Key: string; DefaultValue: Boolean = False): Boolean;
    function GetStringAttribute(Node: IXMLNode; AttrName: string; DefaultValue: string = ''): string;
    function GetIntegerAttribute(Node: IXMLNode; AttrName: string; DefaultValue: Integer = 0): Integer;
    function GetBooleanAttribute(Node: IXMLNode; AttrName: string; DefaultValue: Boolean = False): Boolean;
    function ReadHeader(Node: IXMLNode; AProfile: PProfile): Boolean;
    function ReadBody(Node: IXMLNode; AProfile: PProfile): Boolean;
    function ReadStereotype(Node: IXMLNode; AProfile: PProfile; AStereotype: PStereotype;
      AStereotypeTableItem: PStereotypeTableItem): Boolean;
    function ReadTagDefinitionSet(Node: IXMLNode; AProfile: PProfile; ATagDefinitionSet: PTagDefinitionSet): Boolean;
    function ReadTagDefinition(Node: IXMLNode; ATagDefinition: PTagDefinition): Boolean;
    function ReadDataType(Node: IXMLNode; ADataType: PDataType): Boolean;
    function ReadElementPrototype(Node: IXMLNode; AProfile: PProfile; AElementPrototype: PElementPrototype): Boolean;
    function ReadModelPrototype(Node: IXMLNode; AProfile: PProfile; AModelPrototype: PModelPrototype): Boolean;
    function ReadDiagramType(Node: IXMLNode; AProfile: PProfile; ADiagramType: PDiagramType): Boolean;
    function ReadPalette(Node: IXMLNode; AProfile: PProfile; APalette: PPalette): Boolean;
    procedure Compansate(AProfile: PProfile);
  public
    constructor Create;
    destructor Destroy; override;
    function ReadProfile(AProfile: PProfile): Boolean;
  end;

  // PExtensionManager
  PExtensionManager = class(BasicClasses.PObject)
  private
    FAvailableProfiles: PProfileOrderedSet;
    FIncludedProfiles: PProfileOrderedSet;
    function GetAvailableProfileCount: Integer;
    function GetAvailableProfile(Index: Integer): PProfile;
    function GetIncludedProfileCount: Integer;
    function GetIncludedProfile(Index: Integer): PProfile;
    function CanExcludeProfile(AProfile: PProfile): Boolean;
    procedure DoExcludeProfile(AProfile: PProfile);
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure ClearIncludedProfiles;
    procedure IncludeProfile(AProfileName: string);
    procedure ExcludeProfile(AProfileName: string); overload;
    procedure ExcludeProfile(AProfile: PProfile); overload;
    procedure ExcludeProfile(AProfileIdx: Integer); overload;
    procedure ExcludeAllProfiles;
    function IsIncluded(AProfile: PProfile): Boolean;
    function FindAvailableProfile(AName: string): PProfile;
    function FindIncludedProfile(AName: string): PProfile;
    function FindIncludedProfileIdx(AName: string): Integer;
    function FindStereotype(AProfile, AName: string; BaseClass: string): PStereotype;
    function FindFirstStereotype(Name: string; BaseClass: string): PStereotype;
    function FindTagDefinition(AProfile, ATagDefinitionSetName, AName: string): PTagDefinition;
    function FindTagDefinitionSet(AProfile, AName: string): PTagDefinitionSet;
    function FindDiagramType(AProfile, AName: string): PDiagramType;
    function FindElementPrototype(AProfile, AName: string): PElementPrototype;
    function FindModelPrototype(AProfile, AName: string): PModelPrototype;
    procedure LoadProfiles;
    property AvailableProfileCount: Integer read GetAvailableProfileCount;
    property AvailableProfile[Index: Integer]: PProfile read GetAvailableProfile;
    property AvailableProfiles: PProfileOrderedSet read FAvailableProfiles;
    property IncludedProfileCount: Integer read GetIncludedProfileCount;
    property IncludedProfile[Index: Integer]: PProfile read GetIncludedProfile;
    property IncludedProfiles: PProfileOrderedSet read FIncludedProfiles;
  end;

  // Utilities
  function IsValidTagTypeStr(T: string): Boolean;
  function TagTypeToStr(T: PTagTypeKind): string;
  function StrToTagType(T: string): PTagTypeKind;
  function IsDataTagType(T: PTagTypeKind): Boolean;
  function IsReferenceTagType(T: PTagTypeKind): Boolean;
  function StrToDragType(T: string): PDragTypeKind;

var
  ExtensionManager: PExtensionManager;

implementation

uses
  Windows, Variants, Forms, Registry, Vcl.imaging.jpeg, Vcl.Imaging.pngimage,
  LogMgr, NLS_StarUML;

const
  //PROFILES_REGPATH = '\Software\StarUML\Profiles';
  REG_PROFILE_PATH = 'Path';
  REG_PROFILE_FILENAME = 'FileName';
  REG_PROFILE_ICONFILENAME = 'IconFileName';
  REG_PROFILE_AUTOINCLUDE = 'AutoInclude';

  CURRENT_PRF_VERSION = '2.0';

  PRF_PROFILE = 'PROFILE';
  PRF_HEAD = 'HEADER';
  PRF_BODY = 'BODY';
  PRF_NAME = 'NAME';
  PRF_DISPLAYNAME = 'DISPLAYNAME';
  PRF_DESCRIPTION = 'DESCRIPTION';
  PRF_AUTOINCLUDE = 'AUTOINCLUDE';
  PRF_STEREOTYPELIST = 'STEREOTYPELIST';
  PRF_STEREOTYPE = 'STEREOTYPE';
  PRF_STEREOTYPE_NAME = 'NAME';
  PRF_STEREOTYPE_DESCRIPTION = 'DESCRIPTION';
  PRF_STEREOTYPE_BASECLASSES = 'BASECLASSES';
  PRF_STEREOTYPE_BASECLASS = 'BASECLASS';
  PRF_STEREOTYPE_PARENT = 'PARENT';
  PRF_STEREOTYPE_TAGDEFINITIONSET = 'RELATEDTAGDEFINITIONSET';
  PRF_STEREOTYPE_ICON = 'ICON';
  PRF_STEREOTYPE_SMALLICON = 'SMALLICON';
  PRF_STEREOTYPE_NOTATION = 'NOTATION';
  PRF_TAGDEFINITIONSETLIST = 'TAGDEFINITIONSETLIST';
  PRF_TAGDEFINITIONSET = 'TAGDEFINITIONSET';
  PRF_TAGDEFINITIONSET_NAME = 'NAME';
  PRF_TAGDEFINITIONSET_BASECLASSES = 'BASECLASSES';
  PRF_TAGDEFINITIONSET_BASECLASS = 'BASECLASS';
  PRF_TAGDEFINITIONSET_TAGDEFINITIONLIST = 'TAGDEFINITIONLIST';
  PRF_TAGDEFINITIONSET_TAGDEFINITION = 'TAGDEFINITION';

  PRF_TAGDEFINITION_NAME = 'NAME';
  PRF_TAGDEFINITION_TAGTYPE = 'TAGTYPE';
  PRF_TAGDEFINITION_DEFAULTVALUE = 'DEFAULTDATAVALUE';
  PRF_TAGDEFINITION_LITERALS = 'LITERALS';
  PRF_TAGDEFINITION_LITERAL = 'LITERAL';
  PRF_TAGDEFINITION_REFERENCETYPE = 'REFERENCETYPE';

  PRF_DATATYPELIST = 'DATATYPELIST';
  PRF_DATATYPE = 'DATATYPE';
  PRF_DATATYPE_NAME = 'NAME';

  PRF_DIAGRAMTYPELIST = 'DIAGRAMTYPELIST';
  PRF_DIAGRAMTYPE = 'DIAGRAMTYPE';
  PRF_DIAGRAMTYPE_NAME = 'NAME';
  PRF_DIAGRAMTYPE_DISPLAYNAME = 'DISPLAYNAME';
  PRF_DIAGRAMTYPE_BASEDIAGRAM = 'BASEDIAGRAM';
  PRF_DIAGRAMTYPE_ICON = 'ICON';
  PRF_DIAGRAMTYPE_AVAILABLEPALETTELIST = 'AVAILABLEPALETTELIST';
  PRF_DIAGRAMTYPE_AVAILABLEPALETTE = 'AVAILABLEPALETTE';

  PRF_ELEMENTPROTOTYPELIST = 'ELEMENTPROTOTYPELIST';
  PRF_ELEMENTPROTOTYPE = 'ELEMENTPROTOTYPE';
  PRF_ELEMENTPROTOTYPE_NAME = 'NAME';
  PRF_ELEMENTPROTOTYPE_DISPLAYNAME = 'DISPLAYNAME';
  PRF_ELEMENTPROTOTYPE_ICON = 'ICON';
  PRF_ELEMENTPROTOTYPE_DRAGTYPE = 'DRAGTYPE';
  PRF_ELEMENTPROTOTYPE_BASEELEMENT = 'BASEELEMENT';
  PRF_ELEMENTPROTOTYPE_STEREOTYPENAME = 'STEREOTYPENAME';
  PRF_ELEMENTPROTOTYPE_STEREOTYPEDISPLAY = 'STEREOTYPEDISPLAY';
  PRF_ELEMENTPROTOTYPE_SHOWEXTENDEDNOTATION = 'SHOWEXTENDEDNOTATION';
  PRF_ELEMENTPROTOTYPE_MODELPROPERTYLIST = 'MODELPROPERTYLIST';
  PRF_ELEMENTPROTOTYPE_MODELPROPERTY = 'MODELPROPERTY';
  PRF_ELEMENTPROTOTYPE_VIEWPROPERTYLIST = 'VIEWPROPERTYLIST';
  PRF_ELEMENTPROTOTYPE_VIEWPROPERTY = 'VIEWPROPERTY';
  PRF_ELEMENTPROTOTYPE_PROPERTYNAME = 'NAME';
  PRF_ELEMENTPROTOTYPE_PROPERTYVALUE = 'VALUE';
  PRF_ELEMENTPROTOTYPE_TAGGEDVALUELIST = 'TAGGEDVALUELIST';
  PRF_ELEMENTPROTOTYPE_TAGGEDVALUE = 'TAGGEDVALUE';

  PRF_MODELPROTOTYPELIST = 'MODELPROTOTYPELIST';
  PRF_MODELPROTOTYPE = 'MODELPROTOTYPE';
  PRF_MODELPROTOTYPE_NAME = 'NAME';
  PRF_MODELPROTOTYPE_DISPLAYNAME = 'DISPLAYNAME';
  PRF_MODELPROTOTYPE_ICON = 'ICON';
  PRF_MODELPROTOTYPE_BASEMODEL = 'BASEMODEL';
  PRF_MODELPROTOTYPE_STEREOTYPENAME = 'STEREOTYPENAME';
  PRF_MODELPROTOTYPE_PROPERTYLIST = 'PROPERTYLIST';
  PRF_MODELPROTOTYPE_PROPERTY = 'PROPERTY';
  PRF_MODELPROTOTYPE_PROPERTYNAME = 'NAME';
  PRF_MODELPROTOTYPE_PROPERTYVALUE = 'VALUE';
  PRF_MODELPROTOTYPE_TAGGEDVALUELIST = 'TAGGEDVALUELIST';
  PRF_MODELPROTOTYPE_TAGGEDVALUE = 'TAGGEDVALUE';
  PRF_MODELPROTOTYPE_CONTAINERMODELLIST = 'CONTAINERMODELLIST';
  PRF_MODELPROTOTYPE_CONTAINERMODEL = 'CONTAINERMODEL';

  PRF_PALETTELIST = 'PALETTELIST';
  PRF_PALETTE = 'PALETTE';
  PRF_PALETTE_NAME = 'NAME';
  PRF_PALETTE_DISPLAYNAME = 'DISPLAYNAME';
  PRF_PALETTE_PALETTEITEMLIST = 'PALETTEITEMLIST';
  PRF_PALETTE_PALETTEITEM = 'PALETTEITEM';

  PRF_ATTR_LOCK = 'lock';
  PRF_ATTR_ICON_MINWIDTH = 'minWidth';
  PRF_ATTR_ICON_MINHEIGHT = 'minHeight';
  PRF_ATTR_TYPE = 'type';
  PRF_ATTR_STEREOTYPE = 'stereotype';
  PRF_ATTR_PROFILE = 'profile';
  PRF_ATTR_TAGDEFINITIONSET = 'tagDefintionSet';
  PRF_ATTR_TAGDEFINITION = 'tagDefinition';
  PRF_ATTR_NAME = 'name';
  PRF_ATTR_ARGUMENT = 'argument';

  // must be remove
  PRF_ATTR_COMOBJECTNAME = 'COMObjectName';
  PRF_ATTR_ACTIONID = 'ActionID';

  DEFAULT_ICON_MINWIDTH = 24;
  DEFAULT_ICON_MINHEIGHT = 24;

  EMF_FILE = '.emf';
  WMF_FILE = '.wmf';
  BMP_FILE = '.bmp';
  JPG_FILE = '.jpg';
  JPEG_FILE = '.jpeg';
  PNG_FILE = '.png';

////////////////////////////////////////////////////////////////////////////////
// PExtensibleModel

constructor PExtensibleModel.Create;
begin
  inherited;
  FStereotypeProfile := '';
  FStereotypeName := '';
  FConstraints := PConstraintOrderedSet.Create;
  FTaggedValues := PTaggedValueOrderedSet.Create;
  FReferencingTags := PTaggedValueOrderedSet.Create;
end;

destructor PExtensibleModel.Destroy;
begin
  FConstraints.Free;
  FConstraints := nil;
  FTaggedValues.Free;
  FTaggedValues := nil;
  FReferencingTags.Free;
  FReferencingTags := nil;
  inherited;
end;

procedure PExtensibleModel.SetStereotypeProfile(Value: string);
begin
  if FStereotypeProfile <> Value then
    FStereotypeProfile := Value;
end;

procedure PExtensibleModel.SetStereotypeName(Value: string);
begin
  if FStereotypeName <> Value then
    FStereotypeName := Value;
end;

function PExtensibleModel.GetConstraint(Index: Integer): PConstraint;
begin
  Result := FConstraints.Items[Index];
end;

function PExtensibleModel.GetConstraintCount:Integer;
begin
  Result := FConstraints.Count;
end;

function PExtensibleModel.GetTaggedValue(Index: Integer): PTaggedValue;
begin
  Result := FTaggedValues.Items[Index];
end;

function PExtensibleModel.GetTaggedValueCount:Integer;
begin
  Result := FTaggedValues.Count;
end;

function PExtensibleModel.GetReferencingTag(Index: Integer): PTaggedValue;
begin
  Result := FReferencingTags.Items[Index];
end;

function PExtensibleModel.GetReferencingTagCount: Integer;
begin
  Result := FReferencingTags.Count;
end;

procedure PExtensibleModel.Accept(Visitor: PVisitor);
var
  Constraint: PConstraint;
  TaggedValue: PTaggedValue;
begin
  inherited;
  for Constraint in Constraints do
    Constraint.Accept(Visitor);
  for TaggedValue in TaggedValues do
    TaggedValue.Accept(Visitor);
end;

function PExtensibleModel.GetStereotype: PStereotype;
var
  P: PProfile;
begin
  Result := nil;
  P := ExtensionManager.FindIncludedProfile(FStereotypeProfile);
  if P <> nil then begin
    if MetaClass = nil then
      Result := P.FindStereotype(FStereotypeName, '')
    else
      Result := P.FindStereotype(FStereotypeName, MetaClass.Name);
  end;
end;

procedure PExtensibleModel.SetStereotype(Name: string);
var
  S: PStereotype;
begin
  S := nil;
  if MetaClass <> nil then
    S := ExtensionManager.FindFirstStereotype(Name, MetaClass.Name);
  if S = nil then begin
    FStereotypeProfile := '';
    FStereotypeName := Name;
  end
  else begin
    FStereotypeProfile := S.Profile.Name;
    FStereotypeName := S.Name;
  end;
end;

procedure PExtensibleModel.SetStereotype(Profile: string; Name: string);
var
  S: PStereotype;
begin
  S := nil;
  if MetaClass <> nil then
    S := ExtensionManager.FindStereotype(Profile, Name, MetaClass.Name);
  if S = nil then begin
    FStereotypeProfile := '';
    FStereotypeName := Name;
  end
  else begin
    FStereotypeProfile := S.Profile.Name;
    FStereotypeName := S.Name;
  end;
end;

procedure PExtensibleModel.ClearConstraints;
begin
  while FConstraints.Count > 0 do
    DeleteConstraint(FConstraints.Count-1);
end;

procedure PExtensibleModel.AddConstraint(AConstraint: PConstraint);
begin
  if (AConstraint <> nil) and (not FConstraints.Contains(AConstraint)) then begin
    if AConstraint.FConstrainedModel <> nil then
      AConstraint.FConstrainedModel.FConstraints.Remove(AConstraint);
    FConstraints.Add(AConstraint);
    AConstraint.FConstrainedModel := Self;
  end;
end;

procedure PExtensibleModel.RemoveConstraint(AConstraint: PConstraint);
begin
  if AConstraint <> nil then begin
    FConstraints.Remove(AConstraint);
    AConstraint.FConstrainedModel := nil;
  end;
end;

procedure PExtensibleModel.InsertConstraint(Index: Integer; AConstraint: PConstraint);
begin
  if (AConstraint <> nil) and (not FConstraints.Contains(AConstraint)) then begin
    if AConstraint.FConstrainedModel <> nil then
      AConstraint.FConstrainedModel.FConstraints.Remove(AConstraint);
    FConstraints.Insert(Index, AConstraint);
    AConstraint.FConstrainedModel := Self;
  end;
end;

procedure PExtensibleModel.DeleteConstraint(Index: Integer);
begin
  RemoveConstraint(FConstraints.Items[Index]);
end;

function PExtensibleModel.IndexOfConstraint(AConstraint: PConstraint): Integer;
begin
  Result := FConstraints.IndexOf(AConstraint);
end;

function PExtensibleModel.GetConstraintByGuid(AGuid: string): PConstraint;
var
  Constraint: PConstraint;
begin
  Result := nil;
  for Constraint in Constraints do begin
    if Constraint.GUID = AGuid then
    begin
      Result := Constraint;
      Break;
    end;
  end;
end;

procedure PExtensibleModel.ClearTaggedValues;
begin
  while FTaggedValues.Count > 0 do
    DeleteTaggedValue(FTaggedValues.Count-1);
end;

procedure PExtensibleModel.AddTaggedValue(ATaggedValue: PTaggedValue);
begin
  if (ATaggedValue <> nil) and (not FTaggedValues.Contains(ATaggedValue)) then begin
    if ATaggedValue.FTaggedModel <> nil then
      ATaggedValue.FTaggedModel.FTaggedValues.Remove(ATaggedValue);
    FTaggedValues.Add(ATaggedValue);
    ATaggedValue.FTaggedModel := Self;
  end;
end;

procedure PExtensibleModel.RemoveTaggedValue(ATaggedValue: PTaggedValue);
begin
  if ATaggedValue <> nil then begin
    FTaggedValues.Remove(ATaggedValue);
    ATaggedValue.FTaggedModel := nil;
  end;
end;

procedure PExtensibleModel.InsertTaggedValue(Index: Integer; ATaggedValue: PTaggedValue);
begin
  if (ATaggedValue <> nil) and (not FTaggedValues.Contains(ATaggedValue)) then begin
    if ATaggedValue.FTaggedModel <> nil then
      ATaggedValue.FTaggedModel.FTaggedValues.Remove(ATaggedValue);
    FTaggedValues.Insert(Index, ATaggedValue);
    ATaggedValue.FTaggedModel := Self;
  end;
end;

procedure PExtensibleModel.DeleteTaggedValue(Index: Integer);
begin
  RemoveTaggedValue(FTaggedValues.Items[Index]);
end;

function PExtensibleModel.IndexOfTaggedValue(ATaggedValue: PTaggedValue): Integer;
begin
  Result := FTaggedValues.IndexOf(ATaggedValue);
end;

procedure PExtensibleModel.ClearReferencingTags;
begin
  while FReferencingTags.Count > 0 do
    DeleteReferencingTag(FReferencingTags.Count-1);
end;

procedure PExtensibleModel.AddReferencingTag(ATaggedValue: PTaggedValue);
begin
  if ATaggedValue <> nil then begin
    FReferencingTags.Add(ATaggedValue);
    ATaggedValue.FReferenceValues.Add(Self);
  end;
end;

procedure PExtensibleModel.RemoveReferencingTag(ATaggedValue: PTaggedValue);
begin
  if ATaggedValue <> nil then begin
    FReferencingTags.Remove(ATaggedValue);
    ATaggedValue.FReferenceValues.Remove(Self);
  end;
end;

procedure PExtensibleModel.InsertReferencingTag(Index: Integer; ATaggedValue: PTaggedValue);
begin
  if ATaggedValue <> nil then begin
    FReferencingTags.Insert(Index, ATaggedValue);
    ATaggedValue.FReferenceValues.Add(Self);
  end;
end;

procedure PExtensibleModel.DeleteReferencingTag(Index: Integer);
begin
  RemoveReferencingTag(FReferencingTags.Items[Index]);
end;

function PExtensibleModel.IndexOfReferencingTag(ATaggedValue: PTaggedValue): Integer;
begin
  Result := FReferencingTags.IndexOf(ATaggedValue);
end;

function PExtensibleModel.FindTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): PTaggedValue;
var
  T: PTaggedValue;
begin
  Result := nil;
  for T in TaggedValues do begin
    if (T.ProfileName = Profile) and (T.TagDefinitionSetName = TagDefinitionSet)
        and (T.Name = Name) then begin
      Result := T;
      Break;
    end;
  end;
end;

function PExtensibleModel.QueryDataTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): string;
var
  T: PTaggedValue;
  TD: PTagDefinition;
begin
  T := FindTaggedValue(Profile, TagDefinitionSet, Name);
  if T <> nil then
    Result := T.DataValue
  else begin
    TD := ExtensionManager.FindTagDefinition(Profile, TagDefinitionSet, Name);
    if TD = nil then
      raise ETagDefinitionNotFound.Create('TagDefinition "' + Name + '" is not found in Profile "' + Profile + '".');
    Result := TD.DefaultValue;
  end;
end;

function PExtensibleModel.QueryReferenceTaggedValue(Profile: string; TagDefinitionSet: string; Name: string): PExtensibleModel;
var
  T: PTaggedValue;
  TD: PTagDefinition;
begin
  T := FindTaggedValue(Profile, TagDefinitionSet, Name);
  if T <> nil then
  begin
    TD := T.GetTagDefinition;
    if (TD <> nil) and (TD.TagType = tkReference) then
    begin
      if T.ReferenceValueCount > 0 then
        Result := T.ReferenceValue[0]
      else
        Result := nil;
    end
    else begin
      raise EInvalidTaggedValueType.Create('TaggedValue "' + Name + '" does not have Reference type.');
    end;
  end
  else begin
    TD := ExtensionManager.FindTagDefinition(Profile, TagDefinitionSet, Name);
    if TD = nil then
      raise ETagDefinitionNotFound.Create('TagDefinition "' + Name + '" is not found in Profile "' + Profile + '".');
    Result := nil;
  end;
end;

function PExtensibleModel.IsApplicableTagDefinition(Profile: string; TagDefinitionSet: string; Name: string): Boolean;
var
  T: PTagDefinition;
begin
  T := ExtensionManager.FindTagDefinition(Profile, TagDefinitionSet, Name);
  if T <> nil then
    Result := T.TagDefinitionSet.CanApplyTo(MetaClass.Name)
  else
    Result := False;
end;

function PExtensibleModel.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'StereotypeProfile' then begin
    Result := StereotypeProfile;
  end
  else if Name = 'StereotypeName' then begin
    Result := StereotypeName;
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PExtensibleModel.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'StereotypeProfile' then begin
    StereotypeProfile := Value;
  end
  else if Name = 'StereotypeName' then begin
    StereotypeName := Value;
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

procedure PExtensibleModel.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'Constraints' then begin
    AddConstraint(Value as PConstraint);
  end
  else if Name = 'TaggedValues' then begin
    AddTaggedValue(Value as PTaggedValue);
  end
  else if Name = 'ReferencingTags' then begin
    AddReferencingTag(Value as PTaggedValue);
  end
  else begin
    inherited MOF_AddCollectionItem(Name, Value);
  end;
end;

procedure PExtensibleModel.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'Constraints' then begin
    RemoveConstraint(Value as PConstraint);
  end
  else if Name = 'TaggedValues' then begin
    RemoveTaggedValue(Value as PTaggedValue);
  end
  else if Name = 'ReferencingTags' then begin
    RemoveReferencingTag(Value as PTaggedValue);
  end
  else begin
    inherited MOF_RemoveCollectionItem(Name, Value);
  end;
end;

procedure PExtensibleModel.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  if Name = 'Constraints' then begin
    InsertConstraint(Index, Value as PConstraint);
  end
  else if Name = 'TaggedValues' then begin
    InsertTaggedValue(Index, Value as PTaggedValue);
  end
  else if Name = 'ReferencingTags' then begin
    InsertReferencingTag(Index, Value as PTaggedValue);
  end
  else begin
    inherited MOF_InsertCollectionItem(Name, Index, Value);
  end;
end;

procedure PExtensibleModel.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  if Name = 'Constraints' then begin
    DeleteConstraint(Index);
  end
  else if Name = 'TaggedValues' then begin
    DeleteTaggedValue(Index);
  end
  else if Name = 'ReferencingTags' then begin
    DeleteReferencingTag(Index);
  end
  else begin
    inherited MOF_DeleteCollectionItem(Name, Index);
  end;
end;

procedure PExtensibleModel.MOF_ClearCollection(Name: string);
begin
  if Name = 'Constraints' then begin
    ClearConstraints;
  end
  else if Name = 'TaggedValues' then begin
    ClearTaggedValues;
  end
  else if Name = 'ReferencingTags' then begin
    ClearReferencingTags;
  end
  else begin
    inherited MOF_ClearCollection(Name);
  end;
end;

function PExtensibleModel.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  if Name = 'Constraints' then begin
    Result := IndexOfConstraint(Value as PConstraint);
  end
  else if Name = 'TaggedValues' then begin
    Result := IndexOfTaggedValue(Value as PTaggedValue);
  end
  else if Name = 'ReferencingTags' then begin
    Result := IndexOfReferencingTag(Value as PTaggedValue);
  end
  else begin
    Result := inherited MOF_IndexOfCollectionItem(Name, Value);
  end;
end;

function PExtensibleModel.MOF_GetCollectionItem(Name: string; Index: Integer): PElement;
begin
  if Name = 'Constraints' then begin
    Result := Constraint[Index];
  end
  else if Name = 'TaggedValues' then begin
    Result := TaggedValue[Index];
  end
  else if Name = 'ReferencingTags' then begin
    Result := ReferencingTags[Index];
  end
  else begin
    Result := inherited MOF_GetCollectionItem(Name, Index);
  end;
end;

function PExtensibleModel.MOF_GetCollectionCount(Name: string): Integer;
begin
  if Name = 'Constraints' then begin
    Result := ConstraintCount;
  end
  else if Name = 'TaggedValues' then begin
    Result := TaggedValueCount;
  end
  else if Name = 'ReferencingTags' then begin
    Result := ReferencingTagCount;
  end
  else begin
    Result := inherited MOF_GetCollectionCount(Name);
  end;
end;

// PExtensibleModel
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PConstraint

constructor PConstraint.Create;
begin
  inherited;
  FName := '';
  FBody := '';
  FConstrainedModel := nil;
end;

procedure PConstraint.SetName(Value: string);
begin
  if FName <> Value then
  begin
    FName := Value;
  end;
end;

procedure PConstraint.SetBody(Value: string);
begin
  if FBody <> Value then
  begin
    FBody := Value;
  end;
end;

procedure PConstraint.SetConstrainedModel(Value: PExtensibleModel);
begin
  if FConstrainedModel <> Value then begin
    if FConstrainedModel <> nil then FConstrainedModel.RemoveConstraint(Self);
    FConstrainedModel := Value;
    if FConstrainedModel <> nil then FConstrainedModel.AddConstraint(Self);
  end;
end;

function PConstraint.GetContainingDocument: PDocument;
begin
  if FConstrainedModel = nil then
    Result := nil
  else
    Result := FConstrainedModel.GetContainingDocument;
end;

function PConstraint.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'Name' then begin
    Result := Self.Name;
  end
  else if Name = 'Body' then begin
    Result := Body;
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PConstraint.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'Name' then begin
    Self.Name := Value;
  end
  else if Name = 'Body' then begin
    Body := Value;
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

function PConstraint.MOF_GetReference(Name: string): PElement;
begin
  if Name = 'ConstrainedModel' then begin
    Result := ConstrainedModel;
  end
  else begin
    Result := inherited MOF_GetReference(Name);
  end;
end;

procedure PConstraint.MOF_SetReference(Name: string; Value: PElement);
begin
  if Name = 'ConstrainedModel' then begin
    ConstrainedModel := Value as PExtensibleModel;
  end
  else begin
    inherited MOF_SetReference(Name, Value);
  end;
end;

// PConstraint
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PTaggedValue

constructor PTaggedValue.Create;
begin
  inherited;
  FProfileName := '';
  FName := '';
  FDataValue := '';
  FTaggedModel := nil;
  FReferenceValues := PExtensibleModelOrderedSet.Create;
end;

destructor PTaggedValue.Destroy;
begin
  ClearReferenceValues;
  FreeAndNil(FReferenceValues);
  inherited;
end;

procedure PTaggedValue.SetProfileName(Value: string);
begin
  if FProfileName <> Value then begin
    FProfileName := Value;
  end;
end;

procedure PTaggedValue.SetTagDefinitionSetName(Value: string);
begin
  if FTagDefinitionSetName <> Value then begin
    FTagDefinitionSetName := Value;
  end;
end;

procedure PTaggedValue.SetName(Value: string);
begin
  if FName <> Value then begin
    FName := Value;
  end;
end;

procedure PTaggedValue.SetTaggedModel(Value: PExtensibleModel);
begin
  if FTaggedModel <> Value then begin
    if FTaggedModel <> nil then FTaggedModel.RemoveTaggedValue(Self);
    FTaggedModel := Value;
    if FTaggedModel <> nil then FTaggedModel.AddTaggedValue(Self);
  end;
end;

function PTaggedValue.GetDataValue: string;
begin
  Result := FDataValue;
end;

procedure PTaggedValue.SetDataValue(Value: string);
begin
  if FDataValue <> Value then begin
    FDataValue := Value;
  end;
end;

function PTaggedValue.GetReferenceValueCount: Integer;
begin
  Result := FReferenceValues.Count;
end;

function PTaggedValue.GetReferenceValue(Index: Integer): PExtensibleModel;
begin
  Result := FReferenceValues.Items[Index];
end;

function PTaggedValue.GetTagDefinition: PTagDefinition;
begin
  Result := ExtensionManager.FindTagDefinition(FProfileName, FTagDefinitionSetName, FName);
end;

function PTaggedValue.GetTagDefinitionSet: PTagDefinitionSet;
begin
  Result := ExtensionManager.FindTagDefinitionSet(FProfileName, FTagDefinitionSetName);
end;

function PTaggedValue.GetProfile: PProfile;
begin
  Result := ExtensionManager.FindIncludedProfile(FProfileName);
end;

function PTaggedValue.GetContainingDocument: PDocument;
begin
  if FTaggedModel = nil then
    Result := nil
  else
    Result := FTaggedModel.GetContainingDocument;
end;

procedure PTaggedValue.ClearReferenceValues;
begin
  while FReferenceValues.Count > 0 do
    DeleteReferenceValue(FReferenceValues.Count - 1);
end;

procedure PTaggedValue.AddReferenceValue(Value: PExtensibleModel);
begin
  if Value <> nil then begin
    FReferenceValues.Add(Value);
    Value.FReferencingTags.Add(Self);
  end;
end;

procedure PTaggedValue.RemoveReferenceValue(Value: PExtensibleModel);
begin
  if Value <> nil then begin
    FReferenceValues.Remove(Value);
    Value.FReferencingTags.Remove(Self);
  end;
end;

procedure PTaggedValue.InsertReferenceValue(Index: Integer; Value: PExtensibleModel);
begin
  if Value <> nil then begin
    FReferenceValues.Insert(Index, Value);
    Value.FReferencingTags.Add(Self);
  end;
end;

procedure PTaggedValue.DeleteReferenceValue(Index: Integer);
begin
  RemoveReferenceValue(FReferenceValues.Items[Index]);
end;

function PTaggedValue.IndexOfReferenceValue(Value: PExtensibleModel): Integer;
begin
  Result := FReferenceValues.IndexOf(Value);
end;

function PTaggedValue.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'ProfileName' then begin
    Result := ProfileName;
  end
  else if Name = 'TagDefinitionSetName' then begin
    Result := TagDefinitionSetName;
  end
  else if Name = 'Name' then begin
    Result := Self.Name;
  end
  else if Name = 'DataValue' then begin
    Result := DataValue;
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PTaggedValue.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'ProfileName' then begin
    ProfileName := Value;
  end
  else if Name = 'TagDefinitionSetName' then begin
    TagDefinitionSetName := Value;
  end
  else if Name = 'Name' then begin
    Self.Name := Value;
  end
  else if Name = 'DataValue' then begin
    DataValue := Value;
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

function PTaggedValue.MOF_GetReference(Name: string): PElement;
begin
  if Name = 'TaggedModel' then begin
    Result := TaggedModel;
  end
  else begin
    Result := inherited MOF_GetReference(Name);
  end;
end;

procedure PTaggedValue.MOF_SetReference(Name: string; Value: PElement);
begin
  if Name = 'TaggedModel' then begin
    TaggedModel := Value as PExtensibleModel;
  end
  else begin
    inherited MOF_SetReference(Name, Value);
  end;
end;

procedure PTaggedValue.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'ReferenceValues' then begin
    AddReferenceValue(Value as PExtensibleModel);
  end
  else begin
    inherited MOF_AddCollectionItem(Name, Value);
  end;
end;

procedure PTaggedValue.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'ReferenceValues' then begin
    RemoveReferenceValue(Value as PExtensibleModel);
  end
  else begin
    inherited MOF_RemoveCollectionItem(Name, Value);
  end;
end;

procedure PTaggedValue.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  if Name = 'ReferenceValues' then begin
    InsertReferenceValue(Index, Value as PExtensibleModel);
  end
  else begin
    inherited MOF_InsertCollectionItem(Name, Index, Value);
  end;
end;

procedure PTaggedValue.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  if Name = 'ReferenceValues' then begin
    DeleteReferenceValue(Index);
  end
  else begin
    inherited MOF_DeleteCollectionItem(Name, Index);
  end;
end;

procedure PTaggedValue.MOF_ClearCollection(Name: string);
begin
  if Name = 'ReferenceValues' then begin
    ClearReferenceValues;
  end
  else begin
    inherited MOF_ClearCollection(Name);
  end;
end;

function PTaggedValue.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  if Name = 'ReferenceValues' then begin
    Result := IndexOfReferenceValue(Value as PExtensibleModel);
  end
  else begin
    Result := inherited MOF_IndexOfCollectionItem(Name, Value);
  end;
end;

function PTaggedValue.MOF_GetCollectionItem(Name: string; Index: Integer): PElement;
begin
  if Name = 'ReferenceValues' then begin
    Result := ReferenceValue[Index];
  end
  else begin
    Result := inherited MOF_GetCollectionItem(Name, Index);
  end;
end;

function PTaggedValue.MOF_GetCollectionCount(Name: string): Integer;
begin
  if Name = 'ReferenceValues' then begin
    Result := ReferenceValueCount;
  end
  else begin
    Result := inherited MOF_GetCollectionCount(Name);
  end;
end;

// PTaggedValue
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PTagDefinition

constructor PTagDefinition.Create;
begin
  inherited;
  FLiterals := TStringList.Create;
  FTagDefinitionSet := nil;
  FReferenceType := '';
  FLock := False;
  FDefaultValue := '';
end;

destructor PTagDefinition.Destroy;
begin
  FLiterals.Free;
  inherited;
end;

function PTagDefinition.GetReferenceType: string;
begin
  Result := FReferenceType;
end;

function PTagDefinition.GetLiteral(Index: Integer): string;
begin
  Result := FLiterals.Strings[Index];
end;

function PTagDefinition.GetLiteralCount: Integer;
begin
  Result := FLiterals.Count;
end;

function PTagDefinition.IndexOfLiteral(ALiteral: string): Integer;
begin
  Result := FLiterals.IndexOf(ALiteral);
end;

// PTagDefinition
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PTagDefinitionSet

{ TCollectionEnumerator }

constructor PTagDefinitionSet.TTagDefinitionSetEnumerator.Create(ATagDefinitionSet: PTagDefinitionSet);
begin
  inherited Create;
  FIndex := -1;
  FTagDefinitionSet := ATagDefinitionSet;
end;

function PTagDefinitionSet.TTagDefinitionSetEnumerator.GetCurrent: PTagDefinition;
begin
  Result := FTagDefinitionSet.TagDefinitions[FIndex];
end;

function PTagDefinitionSet.TTagDefinitionSetEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < FTagDefinitionSet.TagDefinitionCount - 1;
  if Result then
    Inc(FIndex);
end;


function PTagDefinitionSet.GetEnumerator: TTagDefinitionSetEnumerator;
begin
  Result := TTagDefinitionSetEnumerator.Create(self);
end;

constructor PTagDefinitionSet.Create;
begin
  inherited;
  FBaseClasses := TStringList.Create;
  FTagDefinitions := PTagDefinitionOrderedSet.Create;
  FProfile := nil;
  FStereotype := nil;
end;

destructor PTagDefinitionSet.Destroy;
var
  TagDefinition: PTagDefinition;
begin
  FBaseClasses.Free;
  FBaseClasses := nil;
  for TagDefinition in FTagDefinitions do
    TagDefinition.Free;
  FreeAndNil(FTagDefinitions);
  inherited;
end;

function PTagDefinitionSet.GetBaseClassCount: Integer;
begin
  Result := FBaseClasses.Count;
end;

function PTagDefinitionSet.GetBaseClass(Index: Integer): string;
begin
  Result := FBaseClasses.Strings[Index];
end;

function PTagDefinitionSet.GetTagDefinitionCount: Integer;
begin
  Result := FTagDefinitions.Count;
end;

function PTagDefinitionSet.GetTagDefinition(Index: Integer): PTagDefinition;
begin
  Result := FTagDefinitions.Items[Index];
end;

function PTagDefinitionSet.FindTagDefinition(AName: string): PTagDefinition;
var
  TagDefinition: PTagDefinition;
begin
  Result := nil;
  for TagDefinition in FTagDefinitions do
    if TagDefinition.Name = AName then begin
      Result := TagDefinition;
      Break;
    end;
end;

function PTagDefinitionSet.CanApplyTo(AClassName: string): Boolean;
var
  MC: PMetaClass;
  I: Integer;
begin
  Result := False;
  MC := MetaModel.FindMetaClass(AClassName);
  if MC = nil then
    raise EMetaClassifierNotExist.Create(MSG_INVALID_CLASS_NAME + ' (' + AClassName + ')');
  for I := 0 to FBaseClasses.Count - 1 do
    if MC.IsKindOf(GetBaseClass(I)) then begin
      Result := True;
      Exit;
    end;
end;

// PTagDefinitionSet
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PStereotype

constructor PStereotype.Create;
begin
  inherited;
  FBaseClasses := TStringList.Create;
  FProfile := nil;
  FParent := nil;
  FChildren := TList.Create;
  FTagDefinitionSet := nil;
  FImageIndex := -1;
  FNotationExpr := nil;
  FIcon := nil;
end;

destructor PStereotype.Destroy;
begin
  FBaseClasses.Free;
  FBaseClasses := nil;
  FChildren.Free;
  FChildren := nil;
  FNotationExpr.Free;
  FNotationExpr := nil;
  if FIcon <> nil then
    FIcon.Free;
  inherited;
end;

function PStereotype.GetBaseClassCount: Integer;
begin
  Result := FBaseClasses.Count;
end;

function PStereotype.GetBaseClass(Index: Integer): string;
begin
  Result := FBaseClasses.Strings[Index];
end;

function PStereotype.GetChildCount: Integer;
begin
  Result := FChildren.Count;
end;

function PStereotype.GetChild(Index: Integer): PStereotype;
begin
  Result := PStereotype(FChildren.Items[Index]);
end;

function PStereotype.GetDerivedTagDefinitionSet: PTagDefinitionSet;
begin
  if FTagDefinitionSet <> nil then
    Result := FTagDefinitionSet
  else if FParent <> nil then
    Result := FParent.DerivedTagDefinitionSet
  else
    Result := nil;
end;

function PStereotype.CanApplyTo(AClassName: string): Boolean;
var
  MC: PMetaClass;
  I: Integer;
begin
  Result := False;
  MC := MetaModel.FindMetaClass(AClassName);
  if MC = nil then
    raise EMetaClassifierNotExist.Create(MSG_INVALID_CLASS_NAME + ' (' + AClassName + ')');
  for I := 0 to FBaseClasses.Count - 1 do
    if MC.IsKindOf(GetBaseClass(I)) then begin
      Result := True;
      Exit;
    end;
end;

function PStereotype.GetNotationExpr: PNXNotationExpr;
begin
  if FNotationExpr <> nil then
    Result := FNotationExpr
  else if FParent <> nil then
    Result := FParent.NotationExpr
  else
    Result := nil;
end;

procedure PStereotype.LoadIconFile;
var
  Ext: string;
begin
  if (FIconFile <> '') and FileExists(FIconFile) then begin
    Ext := LowerCase(ExtractFileExt(FIconFile));

    if (Ext = WMF_FILE) or (Ext = EMF_FILE) then begin
      FIcon := TMetaFile.Create;
      try
        FIcon.LoadFromFile(FIconFile);
      except
        FIcon.Free;
        FIcon := nil;
      end;
    end

    else if (Ext = BMP_FILE) then begin
      FIcon := Graphics.TBitmap.Create;
      try
        FIcon.LoadFromFile(FIconFile);
      except
        FIcon.Free;
        FIcon := nil;
      end;
    end

    else if (Ext = JPG_FILE) or (Ext = JPEG_FILE) then begin
      FIcon := TJPEGImage.Create;
      try
        FIcon.LoadFromFile(FIconFile);
      except
        FIcon.Free;
        FIcon := nil;
      end;
    end

    else if (Ext = PNG_FILE) then begin
      FIcon := TPNGImage.Create;
      try
        FIcon.LoadFromFile(FIconFile);
      except
        FIcon.Free;
        FIcon := nil;
      end;
    end

  end;
end;


// PStereotype
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDataType

constructor PDataType.Create;
begin
  inherited;
  FProfile := nil;
end;

// PDataType
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PElementPrototype

constructor PElementPrototype.Create;
begin
  inherited;
  FModelProperties := TStringList.Create;
  FViewProperties := TStringList.Create;
  FTaggedValues := TStringList.Create;
  FImageIndex := -1;
  FProfile := nil;
end;

destructor PElementPrototype.Destroy;
begin
  FModelProperties.Free;
  FModelProperties := nil;
  FViewProperties.Free;
  FViewProperties := nil;
  FTaggedValues.Free;
  FTaggedValues := nil;
  FProfile := nil;
  inherited;
end;

function PElementPrototype.GetIconFile: string;
begin
  Result := FIconFile;
end;

function PElementPrototype.GetModelPropertyCount: Integer;
begin
  Result := FModelProperties.Count;
end;

function PElementPrototype.GetModelPropertyName(Index: Integer): string;
begin
  Result := FModelProperties.Names[Index];
end;

function PElementPrototype.GetModelPropertyValue(Index: Integer): string;
begin
  Result := FModelProperties.Values[GetModelPropertyName(Index)];
end;

function PElementPrototype.GetViewPropertyCount: Integer;
begin
  Result := FViewProperties.Count;
end;

function PElementPrototype.GetViewPropertyName(Index: Integer): string;
begin
  Result := FViewProperties.Names[Index];
end;

function PElementPrototype.GetViewPropertyValue(Index: Integer): string;
begin
  Result := FViewProperties.Values[GetViewPropertyName(Index)];
end;

procedure PElementPrototype.SetIconFile(AIconFile: string);
begin
  FIconFile := AIconFile;
end;

function PElementPrototype.GetTaggedValueCount: Integer;
begin
  Result := FTaggedValues.Count;
end;

function PElementPrototype.GetTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string): string;
begin
  Result := FTaggedValues.Values[Format('%s,%s,%s', [Profile, TagDefinitionSet, TagDefinition])];
end;

procedure PElementPrototype.AddModelProperty(Name: string; Value: string);
begin
  FModelProperties.Add(Name + '=' + Value);
end;

procedure PElementPrototype.AddViewProperty(Name: string; Value: string);
begin
  FViewProperties.Add(Name + '=' + Value);
end;

procedure PElementPrototype.AddTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string; Value: string);
begin
  FTaggedValues.Add(Format('%s,%s,%s=%s', [Profile, TagDefinitionSet, TagDefinition, Value]))
end;

// PPaletteElement
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PModelPrototype

constructor PModelPrototype.Create;
begin
  inherited;
  FProperties := TStringList.Create;
  FTaggedValues := TStringList.Create;
  FContainerModels := TStringList.Create;
  FContainerModelStereotypes := TStringList.Create;
  FImageIndex := -1;
  FProfile := nil;
end;

destructor PModelPrototype.Destroy;
begin
  FProperties.Free;
  FProperties := nil;
  FTaggedValues.Free;
  FTaggedValues := nil;
  FContainerModels.Free;
  FContainerModels := nil;
  FContainerModelStereotypes.Free;
  FContainerModelStereotypes := nil;
  FProfile := nil;
  inherited;
end;

function PModelPrototype.GetPropertyCount: Integer;
begin
  Result := FProperties.Count;
end;

function PModelPrototype.GetPropertyName(Index: Integer): string;
begin
  Result := FProperties.Names[Index];
end;

function PModelPrototype.GetPropertyValue(Index: Integer): string;
begin
  Result := FProperties.Values[GetPropertyName(Index)];
end;

function PModelPrototype.GetTaggedValueCount: Integer;
begin
  Result := FTaggedValues.Count;
end;

function PModelPrototype.GetTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string): string;
begin
  Result := FTaggedValues.Values[Format('%s,%s,%s', [Profile, TagDefinitionSet, TagDefinition])];
end;

function PModelPrototype.GetContainerModelCount: Integer;
begin
  Result := FContainerModels.Count;
end;

function PModelPrototype.GetContainerModel(Index: Integer): string;
begin
  Result := FContainerModels[Index];
end;

function PModelPrototype.GetContainerModelStereotype(Index: Integer): string;
begin
  Result := FContainerModelStereotypes[Index];
end;

procedure PModelPrototype.AddProperty(Name: string; Value: string);
begin
  FProperties.Add(Name + '=' + Value);
end;

procedure PModelPrototype.AddTaggedValue(Profile: string; TagDefinitionSet: string; TagDefinition: string; Value: string);
begin
  FTaggedValues.Add(Format('%s,%s,%s=%s', [Profile, TagDefinitionSet, TagDefinition, Value]))
end;

procedure PModelPrototype.AddContainerModel(ModelKind: string; StereotypeName: string);
begin
  FContainerModels.Add(ModelKind);
  FContainerModelStereotypes.Add(StereotypeName);
end;

// PModelPrototype
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PPalette

constructor PPalette.Create;
begin
  inherited;
  FPaletteItems := TStringList.Create;
  FProfile := nil;
end;

destructor PPalette.Destroy;
begin
  FPaletteItems.Free;
  FPaletteItems := nil;
  FProfile := nil;
  inherited;
end;

function PPalette.GetPaletteItemCount: Integer;
begin
  Result := FPaletteItems.Count;
end;

function PPalette.GetPaletteItem(Index: Integer): string;
begin
  Result := FPaletteItems[Index];
end;

procedure PPalette.AddPaletteItem(Value: string);
begin
  FPaletteItems.Add(Value);
end;

// PPalette
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDiagramType

constructor PDiagramType.Create;
begin
  inherited;
  FAvailablePalettes := TStringList.Create;
  FProfile := nil;
  FImageIndex := -1;
end;

destructor PDiagramType.Destroy;
begin
  FAvailablePalettes.Free;
  FAvailablePalettes := nil;
  FProfile := nil;
  inherited;
end;

function PDiagramType.GetAvailablePaletteCount: Integer;
begin
  Result := FAvailablePalettes.Count;
end;

function PDiagramType.GetIconFile: string;
begin
  Result := FIconFile;
end;

procedure PDiagramType.SetIconFile(AIconFile: string);
begin
  FIconFile := AIconFile;
end;

function PDiagramType.GetAvailablePalette(Index: Integer): string;
begin
  Result := FAvailablePalettes[Index];
end;

// PDiagramType
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PPRofile

constructor PProfile.Create;
begin
  inherited;
  FStereotypes := PStereotypeOrderedSet.Create;
  FTagDefinitionSets := PTagDefinitionSetOrderedSet.Create;
  FDataTypes := PDataTypeOrderedSet.Create;
  FElementPrototypes := PElementPrototypeOrderedSet.Create;
  FModelPrototypes := PModelPrototypeOrderedSet.Create;
  FDiagramTypes := PDiagramTypeOrderedSet.Create;
  FPalettes := PPaletteOrderedSet.Create;
end;

destructor PProfile.Destroy;
var
 S: PStereotype;
 Tds: PTagDefinitionSet;
 Dt: PDataType;
 Ep: PElementPrototype;
 Mp: PModelPrototype;
 DgT: PDiagramType;
 P: PPalette;
begin
  for S in FStereotypes do
    S.Free;
  FreeAndNil(FStereotypes);

  for Tds in FTagDefinitionSets do
    Tds.Free;
  FreeAndNil(FTagDefinitionSets);

  for Dt in FDataTypes do
    Dt.Free;
  FreeAndNil(FDataTypes);

  for Ep in FElementPrototypes do
    Ep.Free;
  FreeAndNil(FElementPrototypes);

  for Mp in FModelPrototypes do
    Mp.Free;
  FreeAndNil(FModelPrototypes);

  for DgT in FDiagramTypes do
    DgT.Free;
  FreeAndNil(FDiagramTypes);

  for P in FPalettes do
    P.Free;
  FreeAndNil(FPalettes);

  inherited;
end;

function PProfile.GetStereotypeCount: Integer;
begin
  Result := FStereotypes.Count;
end;

function PProfile.GetStereotype(Index: Integer): PStereotype;
begin
  Result := FStereotypes.Items[Index];
end;

function PProfile.GetTagDefinitionSetCount: Integer;
begin
  Result := FTagDefinitionSets.Count;
end;

function PProfile.GetTagDefinitionSet(Index: Integer): PTagDefinitionSet;
begin
  Result := FTagDefinitionSets.Items[Index];
end;

function PProfile.GetDataTypeCount: Integer;
begin
  Result := FDataTypes.Count;
end;

function PProfile.GetDataType(Index: Integer): PDataType;
begin
  Result := FDataTypes.Items[Index];
end;

function PProfile.GetElementPrototypeCount: Integer;
begin
  Result := FElementPrototypes.Count;
end;

function PProfile.GetElementPrototype(Index: Integer): PElementPrototype;
begin
  Result := FElementPrototypes.Items[Index];
end;

function PProfile.GetModelPrototypeCount: Integer;
begin
  Result := FModelPrototypes.Count;
end;

function PProfile.GetModelPrototype(Index: Integer): PModelPrototype;
begin
  Result := FModelPrototypes.Items[Index];
end;

function PProfile.GetDiagramTypeCount: Integer;
begin
  Result := FDiagramTypes.Count;
end;

function PProfile.GetDiagramType(Index: Integer): PDiagramType;
begin
  Result := FDiagramTypes.Items[Index];
end;

function PProfile.GetPaletteCount: Integer;
begin
  Result := FPalettes.Count;
end;

function PProfile.GetPalette(Index: Integer): PPalette;
begin
  Result := FPalettes.Items[Index];
end;

function PProfile.FindTagDefinition(ATagDefinitionSetName, AName: string): PTagDefinition;
var
  TS: PTagDefinitionSet;
begin
  Result := nil;
  TS := FindTagDefinitionSet(ATagDefinitionSetName);
  if TS <> nil then
    Result := TS.FindTagDefinition(AName);
end;

function PProfile.FindTagDefinitionSet(AName: string): PTagDefinitionSet;
var
 TagDefinitionSet: PTagDefinitionSet;
begin
  Result := nil;
  for TagDefinitionSet in FTagDefinitionSets do
    if TagDefinitionSet.Name = AName then begin
      Result := TagDefinitionSet;
      Break;
    end;
end;

function PProfile.FindStereotype(AName: string; BaseClass: string): PStereotype;
var
  Stereotype: PStereotype;
begin
  Result := nil;
  for Stereotype in FStereotypes do
    if Stereotype.Name = AName then begin
      if BaseClass = '' then begin
        Result := Stereotype;
        Break;
      end
      else if Stereotype.CanApplyTo(BaseClass) then begin
        Result := Stereotype;
        Break;
      end;
    end;
end;

function PProfile.FindDataType(AName: string): PDataType;
var
  DataType: PDataType;
begin
  Result := nil;
  for DataType in FDataTypes do
    if DataType.Name = AName then begin
      Result := DataType;
      Break;
    end;
end;

function PProfile.FindElementPrototype(AName: string): PElementPrototype;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FElementPrototypes.Count - 1 do
    if GetElementPrototype(I).Name = AName then begin
      Result := GetElementPrototype(I);
      Exit;
    end;
end;

function PProfile.FindModelPrototype(AName: string): PModelPrototype;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FModelPrototypes.Count - 1 do
    if GetModelPrototype(I).Name = AName then begin
      Result := GetModelPrototype(I);
      Exit;
    end;
end;

function PProfile.FindDiagramType(AName: string): PDiagramType;
var
  DiagramType: PDiagramType;
begin
  Result := nil;
  for DiagramType in FDiagramTypes do
    if DiagramType.Name = AName then begin
      Result := DiagramType;
      Break;
    end;
end;

function PProfile.FindPalette(AName: string): PPalette;
var
  Palette: PPalette;
begin
  Result := nil;
  for Palette in FPalettes do
    if Palette.Name = AName then begin
      Result := Palette;
      Break;
    end;
end;

function PProfile.FindPrototypeNameForStereotype(
  AStereotypeName: string): string;
var
  EP: PElementPrototype;
begin
    Result := '';
    for EP in FElementPrototypes do
       if EP.StereotypeName = AStereotypeName then begin
          Result := EP.Name;
          Exit;
       end;
end;

// PPRofile
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PProfileReader

constructor PProfileReader.Create;
begin
  StereotypeTable := TList.Create;
end;

destructor PProfileReader.Destroy;
begin
  ClearStereotypeTable;
  StereotypeTable.Free;
  StereotypeTable := nil;
  inherited;
end;

procedure PProfileReader.Report(Msg: string);
begin
  // Log messsage or raise event.
  // call this method when need to report error or information on file reading
end;

procedure PProfileReader.ClearStereotypeTable;
var
  I: Integer;
begin
  for I := StereotypeTable.Count - 1 downto 0 do
    PStereotypeTableItem(StereotypeTable.Items[I]).Free;
end;

function PProfileReader.FindChild(Node: IXMLNode; Key: string): IXMLNode;
begin
  Result := Node.ChildNodes.FindNode(Key);
end;

function PProfileReader.FindSibling(Node: IXMLNode; Key: string): IXMLNode;
var
  N: IXMLNode;
begin
  Result := nil;
  N := Node;
  while N.NextSibling <> nil do begin
    N := N.NextSibling;
    if N.GetLocalName = Key then begin
      Result := N;
      Exit;
    end;
  end;
end;

function PProfileReader.ReadStringNodeValue(Node: IXMLNode; DefaultValue: string = ''): string;
begin
  if VarIsStr(Node.NodeValue) then
    Result := Node.NodeValue
  else
    Result := DefaultValue;
end;

function PProfileReader.ReadChildStringValue(OwnerNode: IXMLNode; Key: string; DefaultValue: string = ''): string;
begin
  if VarIsStr(OwnerNode.ChildValues[Key]) then
    Result := OwnerNode.ChildValues[Key]
  else
    Result := DefaultValue;
end;

function PProfileReader.ReadChildIntegerValue(OwnerNode: IXMLNode; Key: string; DefaultValue: Integer = 0): Integer;
begin
  if VarIsOrdinal(OwnerNode.ChildValues[Key]) then
    Result := OwnerNode.ChildValues[Key]
  else if VarIsStr(OwnerNode.ChildValues[Key]) then
    Result := StrToIntDef(OwnerNode.ChildValues[Key], DefaultValue)
  else
    Result := DefaultValue;
end;

function PProfileReader.ReadChildBooleanValue(OwnerNode: IXMLNode; Key: string; DefaultValue: Boolean = False): Boolean;
begin
  if VarIsType(OwnerNode.ChildValues[Key], varBoolean) then
    Result := OwnerNode.ChildValues[Key]
  else if VarIsStr(OwnerNode.ChildValues[Key]) then
    Result := StrToBoolDef(OwnerNode.ChildValues[Key], DefaultValue)
  else
    Result := DefaultValue;
end;

function PProfileReader.GetStringAttribute(Node: IXMLNode; AttrName: string; DefaultValue: string = ''): string;
begin
  Result := DefaultValue;
  if Node.HasAttribute(AttrName) then
    if VarIsStr(Node.Attributes[AttrName]) then
      Result := Node.Attributes[AttrName];
end;

function PProfileReader.GetIntegerAttribute(Node: IXMLNode; AttrName: string; DefaultValue: Integer = 0): Integer;
begin
  Result := DefaultValue;
  if Node.HasAttribute(AttrName) then begin
    if VarIsOrdinal(Node.Attributes[AttrName]) then // is not exact currently
      Result := Node.Attributes[AttrName]
    else if VarIsStr(Node.Attributes[AttrName]) then
      Result := StrToIntDef(Node.Attributes[AttrName], DefaultValue);
  end;
end;

function PProfileReader.GetBooleanAttribute(Node: IXMLNode; AttrName: string; DefaultValue: Boolean = False): Boolean;
begin
  Result := DefaultValue;
  if Node.HasAttribute(AttrName) then begin
    if VarIsType(Node.Attributes[AttrName], varBoolean) then
      Result := Node.Attributes[AttrName]
    else if VarIsStr(Node.Attributes[AttrName]) then
      try
        Result := StrToBool(Node.Attributes[AttrName]);
      except
        Result := DefaultValue;
      end;
  end;
end;

function PProfileReader.ReadHeader(Node: IXMLNode; AProfile: PProfile): Boolean;
var S: String;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_HEAD, 'Invalid XMLNode');
  Assert(AProfile <> nil, 'Profile is not created');
  // PRECONDITION

  Result := True;

  AProfile.FName := ReadChildStringValue(Node, PRF_NAME);
  if AProfile.FName = '' then begin
    Result := False;
    Exit;
  end;

  AProfile.FDisplayName := ReadChildStringValue(Node, PRF_DISPLAYNAME);
  if AProfile.FDisplayName = '' then begin
    Result := False;
    Exit;
  end;

  AProfile.FDescription := ReadChildStringValue(Node, PRF_DESCRIPTION);

  S := ReadChildStringValue(Node, PRF_AUTOINCLUDE);
  if S <> '' then
    AProfile.FAutoInclude := StrToBool(S)
  else
    AProfile.FAutoInclude := false;

end;

function PProfileReader.ReadBody(Node: IXMLNode; AProfile: PProfile): Boolean;
var
  L, N: IXMLNode;
  S: PStereotype;
  SI: PStereotypeTableItem;
  TS: PTagDefinitionSet;
  D: PDataType;
  Dgm: PDiagramType;
  EP: PElementPrototype;
  MP: PModelPrototype;
  P: PPalette;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_BODY, 'Invalid XMLNode');
  Assert(AProfile <> nil, 'Profile not created');
  // PRECONDITION

  Result := True;

  L := FindChild(Node, PRF_STEREOTYPELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_STEREOTYPE);
    while N <> nil do begin
      S := PStereotype.Create;
      SI := PStereotypeTableItem.Create;
      if ReadStereotype(N, AProfile, S, SI) then begin
        AProfile.FStereotypes.Add(S);
        S.FProfile := AProfile;
        StereotypeTable.Add(SI);
      end
      else begin
        S.Free;
        SI.Free;
      end;
      N := FindSibling(N, PRF_STEREOTYPE);
    end;
  end;

  L := FindChild(Node, PRF_TAGDEFINITIONSETLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_TAGDEFINITIONSET);
    while N <> nil do begin
      TS := PTagDefinitionSet.Create;
      if ReadTagDefinitionSet(N, AProfile, TS) then begin
        AProfile.FTagDefinitionSets.Add(TS);
        TS.FProfile := AProfile;
      end
      else
        TS.Free;
      N := FindSibling(N, PRF_TAGDEFINITIONSET);
    end;
  end;

  L := FindChild(Node, PRF_DATATYPELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_DATATYPE);
    while N <> nil do begin
      D := PDataType.Create;
      if ReadDataType(N, D) then begin
        AProfile.FDataTypes.Add(D);
        D.FProfile := AProfile;
      end
      else
        D.Free;
      N := FindSibling(N, PRF_DATATYPE);
    end;
  end;

  L := FindChild(Node, PRF_ELEMENTPROTOTYPELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_ELEMENTPROTOTYPE);
    while N <> nil do begin
      EP := PElementPrototype.Create;
      if ReadElementPrototype(N, AProfile, EP) then begin
        AProfile.FElementPrototypes.Add(EP);
        EP.FProfile := AProfile;
      end
      else
        EP.Free;
      N := FindSibling(N, PRF_ELEMENTPROTOTYPE);
    end;
  end;

  L := FindChild(Node, PRF_MODELPROTOTYPELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_MODELPROTOTYPE);
    while N <> nil do begin
      MP := PModelPrototype.Create;
      if ReadModelPrototype(N, AProfile, MP) then begin
        AProfile.FModelPrototypes.Add(MP);
        MP.FProfile := AProfile;
      end
      else
        MP.Free;
      N := FindSibling(N, PRF_MODELPROTOTYPE);
    end;
  end;

  L := FindChild(Node, PRF_DIAGRAMTYPELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_DIAGRAMTYPE);
    while N <> nil do begin
      Dgm := PDiagramType.Create;
      if ReadDiagramType(N, AProfile, Dgm) then begin
        AProfile.FDiagramTypes.Add(Dgm);
        Dgm.FProfile := AProfile;
      end
      else
        Dgm.Free;
      N := FindSibling(N, PRF_DIAGRAMTYPE);
    end;
  end;

  L := FindChild(Node, PRF_PALETTELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_PALETTE);
    while N <> nil do begin
      P := PPalette.Create;
      if ReadPalette(N, AProfile, P) then begin
        AProfile.FPalettes.Add(P);
        P.FProfile := AProfile;
      end
      else
        P.Free;
      N := FindSibling(N, PRF_PALETTE);
    end;
  end;
end;

function PProfileReader.ReadStereotype(Node: IXMLNode; AProfile: PProfile;
  AStereotype: PStereotype; AStereotypeTableItem: PStereotypeTableItem): Boolean;
var
  L, N: IXMLNode;
  F: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_STEREOTYPE, 'Invalid XMLNode');
  Assert(AStereotype <> nil, 'Stereotype not created');
  // PRECONDITION

  Result := True;

  AStereotype.FName := ReadChildStringValue(Node, PRF_STEREOTYPE_NAME);
  if AStereotype.FName = '' then begin
    Result := False;
    Exit;
  end;
  AStereotypeTableItem.Stereotype := AStereotype.FName;
  AStereotype.FDescription := ReadChildStringValue(Node, PRF_STEREOTYPE_DESCRIPTION);

  L := FindChild(Node, PRF_STEREOTYPE_BASECLASSES);
  if L <> nil then begin
    N := FindChild(L, PRF_STEREOTYPE_BASECLASS);
    while N <> nil do begin
      if VarIsStr(N.NodeValue) then
        AStereotype.FBaseClasses.Add(N.NodeValue);
      N := FindSibling(N, PRF_STEREOTYPE_BASECLASS);
    end;
  end;

  AStereotypeTableItem.Parent := ReadChildStringValue(Node, PRF_STEREOTYPE_PARENT);
  AStereotypeTableItem.TagDefinitionSet := ReadChildStringValue(Node, PRF_STEREOTYPE_TAGDEFINITIONSET);

  N := FindChild(Node, PRF_STEREOTYPE_ICON);
  if N <> nil then begin
    AStereotype.FIconMinWidth := GetIntegerAttribute(N, PRF_ATTR_ICON_MINWIDTH, DEFAULT_ICON_MINWIDTH);
    AStereotype.FIconMinHeight := GetIntegerAttribute(N, PRF_ATTR_ICON_MINHEIGHT, DEFAULT_ICON_MINHEIGHT);
    F := ReadChildStringValue(Node, PRF_STEREOTYPE_ICON);
    if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then begin
      AStereotype.FIconFile := AProfile.Path + '\' + F;
      AStereotype.LoadIconFile;
    end;
  end;

  F := ReadChildStringValue(Node, PRF_STEREOTYPE_SMALLICON);
  if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then begin
    AStereotype.FSmallIconFile := AProfile.Path + '\' + F;
  end;

  // edited by hskim 2005.08.09 begin
  N := FindChild(Node, PRF_STEREOTYPE_NOTATION);
  if N <> nil then begin
    F := ReadChildStringValue(Node, PRF_STEREOTYPE_NOTATION);
    if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then begin
      AStereotype.FNotationExpr := NXManager.ReadExpr(AProfile.Path + '\' + F);
    end;
  end;
  // edited by hskim 2005.08.09 end
end;

function PProfileReader.ReadTagDefinitionSet(Node: IXMLNode; AProfile: PProfile; ATagDefinitionSet: PTagDefinitionSet): Boolean;
var
  L, N: IXMLNode;
  T: PTagDefinition;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_TAGDEFINITIONSET, 'Invalid XMLNode');
  Assert(ATagDefinitionSet <> nil, 'TagDefinitionSet not created');
  // PRECONDITION

  Result := True;

  ATagDefinitionSet.FName := ReadChildStringValue(Node, PRF_TAGDEFINITIONSET_NAME);
  if ATagDefinitionSet.FName = '' then begin
    Result := False;
    Exit;
  end;

  L := FindChild(Node, PRF_TAGDEFINITIONSET_BASECLASSES);
  if L <> nil then begin
    N := FindChild(L, PRF_TAGDEFINITIONSET_BASECLASS);
    while N <> nil do begin
      if VarIsStr(N.NodeValue) then
        ATagDefinitionSet.FBaseClasses.Add(N.NodeValue);
      N := FindSibling(N, PRF_TAGDEFINITIONSET_BASECLASS);
    end;
  end;

  L := FindChild(Node, PRF_TAGDEFINITIONSET_TAGDEFINITIONLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_TAGDEFINITIONSET_TAGDEFINITION);
    while N <> nil do begin
      T := PTagDefinition.Create;
      if ReadTagDefinition(N, T) then begin
        ATagDefinitionSet.FTagDefinitions.Add(T);
        T.FTagDefinitionSet := ATagDefinitionSet;
      end
      else
        T.Free;
      N := FindSibling(N, PRF_TAGDEFINITIONSET_TAGDEFINITION);
    end;
  end;
end;

function PProfileReader.ReadTagDefinition(Node: IXMLNode; ATagDefinition: PTagDefinition): Boolean;
var
  L, N: IXMLNode;
  TK: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_TAGDEFINITIONSET_TAGDEFINITION, 'Invalid XMLNode');
  Assert(ATagDefinition <> nil, 'TagDefinition not created');
  // PRECONDITION

  Result := True;

  ATagDefinition.FName := ReadChildStringValue(Node, PRF_TAGDEFINITION_NAME);
  if ATagDefinition.FName = '' then begin
    Result := False;
    Exit;
  end;

  TK := ReadChildStringValue(Node, PRF_TAGDEFINITION_TAGTYPE);
  if not IsValidTagTypeStr(TK) then begin
    Result := False;
    Exit;
  end;

  ATagDefinition.FTagType := StrToTagType(TK);
  ATagDefinition.FLock := GetBooleanAttribute(Node, PRF_ATTR_LOCK, False);
  // Need to check validness of default value by Tag type?
  case ATagDefinition.TagType of
    tkInteger: ATagDefinition.FDefaultValue := ReadChildStringValue(Node, PRF_TAGDEFINITION_DEFAULTVALUE, '0');
    tkBoolean: ATagDefinition.FDefaultValue := ReadChildStringValue(Node, PRF_TAGDEFINITION_DEFAULTVALUE, 'False');
    tkReal: ATagDefinition.FDefaultValue := ReadChildStringValue(Node, PRF_TAGDEFINITION_DEFAULTVALUE, '0');
    else
      ATagDefinition.FDefaultValue := ReadChildStringValue(Node, PRF_TAGDEFINITION_DEFAULTVALUE);
  end;
  L := FindChild(Node, PRF_TAGDEFINITION_LITERALS);
  if L <> nil then begin
    N := FindChild(L, PRF_TAGDEFINITION_LITERAL);
    while N <> nil do begin
      if VarIsStr(N.NodeValue) then
        ATagDefinition.FLiterals.Add(N.NodeValue);
      N := FindSibling(N, PRF_TAGDEFINITION_LITERAL);
    end;
  end;
  ATagDefinition.FReferenceType := ReadChildStringValue(Node, PRF_TAGDEFINITION_REFERENCETYPE);
end;


function PProfileReader.ReadDataType(Node: IXMLNode; ADataType: PDataType): Boolean;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_DATATYPE, 'Invalid XMLNode');
  Assert(ADataType <> nil, 'DataType not created');
  // PRECONDITION

  Result := True;
  ADataType.FName := ReadChildStringValue(Node, PRF_DATATYPE_NAME);
  if ADataType.FName = '' then begin
    Result := False;
    Exit;
  end;
end;

function PProfileReader.ReadElementPrototype(Node: IXMLNode; AProfile: PProfile; AElementPrototype: PElementPrototype): Boolean;
var
  L, N: IXMLNode;
  F, PropName, PropValue: string;
  Prf, Tds, Td, TagValue: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_ELEMENTPROTOTYPE, 'Invalid XMLNode');
  Assert(AElementPrototype <> nil, 'ElementPrototype not created');
  // PRECONDITION

  Result := True;
  AElementPrototype.FName := ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_NAME);
  if AElementPrototype.FName = '' then begin
    Result := False;
    Exit;
  end;
  AElementPrototype.FDisplayName := ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_DISPLAYNAME);
  if AElementPrototype.FDisplayName = '' then begin
    Result := False;
    Exit;
  end;

  N := FindChild(Node, PRF_ELEMENTPROTOTYPE_BASEELEMENT);
  if N <> nil then begin
    AElementPrototype.FBaseElement := ReadStringNodeValue(N);
    AElementPrototype.FArgument := GetIntegerAttribute(N, PRF_ATTR_ARGUMENT);
  end;
  if AElementPrototype.FBaseElement = '' then begin
    Result := False;
    Exit;
  end;

  F := ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_ICON);
  if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then
    AElementPrototype.IconFile := AProfile.Path + '\' + F;

  AElementPrototype.FDragType := StrToDragType(ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_DRAGTYPE));
  AElementPrototype.FStereotypeName := ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_STEREOTYPENAME);
  AElementPrototype.FStereotypeDisplay := ReadChildStringValue(Node, PRF_ELEMENTPROTOTYPE_STEREOTYPEDISPLAY);
  AElementPrototype.FShowExtendedNotation := ReadChildBooleanValue(Node, PRF_ELEMENTPROTOTYPE_SHOWEXTENDEDNOTATION);

  L := FindChild(Node, PRF_ELEMENTPROTOTYPE_MODELPROPERTYLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_ELEMENTPROTOTYPE_MODELPROPERTY);
    while N <> nil do begin
      PropName := GetStringAttribute(N, PRF_ATTR_NAME);
      PropValue := ReadStringNodeValue(N);
      if PropName <> '' then
        AElementPrototype.AddModelProperty(PropName, PropValue);
      N := FindSibling(N, PRF_ELEMENTPROTOTYPE_MODELPROPERTY);
    end;
  end;

  L := FindChild(Node, PRF_ELEMENTPROTOTYPE_VIEWPROPERTYLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_ELEMENTPROTOTYPE_VIEWPROPERTY);
    while N <> nil do begin
      PropName := GetStringAttribute(N, PRF_ATTR_NAME);
      PropValue := ReadStringNodeValue(N);
      if PropName <> '' then
        AElementPrototype.AddViewProperty(PropName, PropValue);
      N := FindSibling(N, PRF_ELEMENTPROTOTYPE_VIEWPROPERTY);
    end;
  end;

  L := FindChild(Node, PRF_ELEMENTPROTOTYPE_TAGGEDVALUELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_ELEMENTPROTOTYPE_TAGGEDVALUE);
    while N <> nil do begin
      Prf := GetStringAttribute(N, PRF_ATTR_PROFILE);
      Tds := GetStringAttribute(N, PRF_ATTR_TAGDEFINITIONSET);
      Td := GetStringAttribute(N, PRF_ATTR_TAGDEFINITION);
      TagValue := ReadStringNodeValue(N);
      if (Tds = '') or (Td = '') then begin
        Result := False;
        Exit;
      end;
      AElementPrototype.AddTaggedValue(Prf, Tds, Td, TagValue);
      N := FindSibling(N, PRF_ELEMENTPROTOTYPE_TAGGEDVALUE);
    end;
  end;
end;

function PProfileReader.ReadModelPrototype(Node: IXMLNode; AProfile: PProfile; AModelPrototype: PModelPrototype): Boolean;
var
  L, N: IXMLNode;
  F, PropName, PropValue: string;
  E, ES: string;
  Prf, Tds, Td, TagValue: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_MODELPROTOTYPE, 'Invalid XMLNode');
  Assert(AModelPrototype <> nil, 'ModelPrototype not created');
  // PRECONDITION

  Result := True;
  AModelPrototype.FName := ReadChildStringValue(Node, PRF_MODELPROTOTYPE_NAME);
  if AModelPrototype.FName = '' then begin
    Result := False;
    Exit;
  end;
  AModelPrototype.FDisplayName := ReadChildStringValue(Node, PRF_MODELPROTOTYPE_DISPLAYNAME);
  if AModelPrototype.FDisplayName = '' then begin
    Result := False;
    Exit;
  end;
  N := FindChild(Node, PRF_MODELPROTOTYPE_BASEMODEL);
  if N <> nil then begin
    AModelPrototype.FBaseModel := ReadStringNodeValue(N);
    AModelPrototype.FArgument := GetIntegerAttribute(N, PRF_ATTR_ARGUMENT);
  end;
  if AModelPrototype.FBaseModel = '' then begin
    Result := False;
    Exit;
  end;

  F := ReadChildStringValue(Node, PRF_MODELPROTOTYPE_ICON);
  if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then
    AModelPrototype.FIconFile := AProfile.Path + '\' + F;

  AModelPrototype.FStereotypeName := ReadChildStringValue(Node, PRF_MODELPROTOTYPE_STEREOTYPENAME);

  L := FindChild(Node, PRF_MODELPROTOTYPE_PROPERTYLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_MODELPROTOTYPE_PROPERTY);
    while N <> nil do begin
      PropName := GetStringAttribute(N, PRF_ATTR_NAME);
      PropValue := ReadStringNodeValue(N);
      if PropName <> '' then
        AModelPrototype.AddProperty(PropName, PropValue);
      N := FindSibling(N, PRF_MODELPROTOTYPE_PROPERTY);
    end;
  end;

  L := FindChild(Node, PRF_MODELPROTOTYPE_TAGGEDVALUELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_MODELPROTOTYPE_TAGGEDVALUE);
    while N <> nil do begin
      Prf := GetStringAttribute(N, PRF_ATTR_PROFILE);
      Tds := GetStringAttribute(N, PRF_ATTR_TAGDEFINITIONSET);
      Td := GetStringAttribute(N, PRF_ATTR_TAGDEFINITION);
      TagValue := ReadStringNodeValue(N);
      if (Tds = '') or (Td = '') then begin
        Result := False;
        Exit;
      end;
      AModelPrototype.AddTaggedValue(Prf, Tds, Td, TagValue);
      N := FindSibling(N, PRF_MODELPROTOTYPE_TAGGEDVALUE);
    end;
  end;

  L := FindChild(Node, PRF_MODELPROTOTYPE_CONTAINERMODELLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_MODELPROTOTYPE_CONTAINERMODEL);
    while N <> nil do begin
      E := GetStringAttribute(N, PRF_ATTR_TYPE);
      ES := GetStringAttribute(N, PRF_ATTR_STEREOTYPE);
      if E = '' then begin
        Result := False;
        Exit;
      end;
      AModelPrototype.AddContainerModel(E, ES);
      N := FindSibling(N, PRF_MODELPROTOTYPE_CONTAINERMODEL);
    end;
  end;
end;

function PProfileReader.ReadDiagramType(Node: IXMLNode; AProfile: PProfile; ADiagramType: PDiagramType): Boolean;
var
  L, N: IXMLNode;
  F: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_DIAGRAMTYPE, 'Invalid XMLNode');
  Assert(ADiagramType <> nil, 'DiagramType not created');
  // PRECONDITION

  Result := True;
  ADiagramType.FName := ReadChildStringValue(Node, PRF_DIAGRAMTYPE_NAME);
  if ADiagramType.FName = '' then begin
    Result := False;
    Exit;
  end;
  ADiagramType.FDisplayName := ReadChildStringValue(Node, PRF_DIAGRAMTYPE_DISPLAYNAME);
  if ADiagramType.FDisplayName = '' then begin
    Result := False;
    Exit;
  end;
  ADiagramType.FBaseDiagram := ReadChildStringValue(Node, PRF_DIAGRAMTYPE_BASEDIAGRAM);
  if ADiagramType.FBaseDiagram = '' then begin
    Result := False;
    Exit;
  end;

  F := ReadChildStringValue(Node, PRF_DIAGRAMTYPE_ICON);
  if (F <> '') and (FileExists(AProfile.Path + '\' + F)) then
    ADiagramType.IconFile := AProfile.Path + '\' + F;

  L := FindChild(Node, PRF_DIAGRAMTYPE_AVAILABLEPALETTELIST);
  if L <> nil then begin
    N := FindChild(L, PRF_DIAGRAMTYPE_AVAILABLEPALETTE);
    while N <> nil do begin
      if VarIsStr(N.NodeValue) then
        ADiagramType.FAvailablePalettes.Add(N.NodeValue);
      N := FindSibling(N, PRF_DIAGRAMTYPE_AVAILABLEPALETTE);
    end;
  end;
end;

function PProfileReader.ReadPalette(Node: IXMLNode; AProfile: PProfile; APalette: PPalette): Boolean;
var
  L, N: IXMLNode;
  PI: string;
begin
  // PRECONDITION
  Assert(Node <> nil, 'Invalid XMLNode');
  Assert(Node.LocalName = PRF_PALETTE, 'Invalid XMLNode');
  Assert(APalette <> nil, 'Palette not created');
  // PRECONDITION

  Result := True;
  APalette.FName := ReadChildStringValue(Node, PRF_PALETTE_NAME);
  if APalette.FName = '' then begin
    Result := False;
    Exit;
  end;
  APalette.FDisplayName := ReadChildStringValue(Node, PRF_PALETTE_DISPLAYNAME);
  if APalette.FDisplayName = '' then begin
    Result := False;
    Exit;
  end;

  L := FindChild(Node, PRF_PALETTE_PALETTEITEMLIST);
  if L <> nil then begin
    N := FindChild(L, PRF_PALETTE_PALETTEITEM);
    while N <> nil do begin
      PI := ReadStringNodeValue(N);
      if PI <> '' then
        APalette.AddPaletteItem(PI);
      N := FindSibling(N, PRF_PALETTE_PALETTEITEM);
    end;
  end;
end;

procedure PProfileReader.Compansate(AProfile: PProfile);
var
  SI: PStereotypeTableItem;
  S, P: PStereotype;
  T: PTagDefinitionSet;
  I: Integer;
begin
  // link parent-child and stereotype-tagdefinitionset relation
  for I := 0 to StereotypeTable.Count - 1 do begin
    SI := PStereotypeTableItem(StereotypeTable.Items[I]);
    S := AProfile.FindStereotype(SI.Stereotype, '');
    if SI.Parent <> '' then begin
      P := AProfile.FindStereotype(SI.Parent, '');
      if P <> nil then begin
        S.FParent := P;
        P.FChildren.Add(S);
      end;
    end;
    if SI.TagDefinitionSet <> '' then begin
      T := AProfile.FindTagDefinitionSet(SI.TagDefinitionSet);
      if T <> nil then begin
        S.FTagDefinitionSet := T;
        T.FStereotype := S;
      end;
    end;
  end;
  // set tagdefinitionset's baseclasses as stereotype's baseclasses
  for I := 0 to AProfile.TagDefinitionSetCount - 1 do
    if AProfile.TagDefinitionSet[I].Stereotype <> nil then
      AProfile.TagDefinitionSet[I].FBaseClasses.Assign(AProfile.TagDefinitionSet[I].Stereotype.FBaseClasses);
end;

function PProfileReader.ReadProfile(AProfile: PProfile): Boolean;
var
  XMLDoc: TXMLDocument;
  RootNode: IXMLNode;
  HNode, BNode: IXMLNode;
begin
  // PRECONDITION
  Assert(AProfile <> nil, 'Profile not created');
  // PRECONDITION

  ClearStereotypeTable;
  XMLDoc := TXMLDocument.Create(Application);
  try
    try
      XMLDoc.LoadFromFile(AProfile.FileName);
      // check AsyncLoadState
      if XMLDoc.IsEmptyDoc then begin
        Result := False;
        Exit;
      end;
      RootNode := XMLDoc.DocumentElement;
      if RootNode.LocalName <> PRF_PROFILE then begin
        Result := False;
        Exit;
      end;
      HNode := FindChild(RootNode, PRF_HEAD);
      if HNode = nil then begin
        Result := False;
        Exit;
      end;
      BNode := FindChild(RootNode, PRF_BODY);
      if BNode = nil then begin
        Result := False;
        Exit;
      end;
      Result := ReadHeader(HNode, AProfile) and ReadBody(BNode, AProfile);
      if Result then
        Compansate(AProfile);
    except
      Result := False;
    end;
  finally
    XMLDoc.Free;
  end;
end;

// PProfileReader
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PExtensionManager

constructor PExtensionManager.Create;
begin
  inherited;
  FAvailableProfiles := PProfileOrderedSet.Create;
  FIncludedProfiles := PProfileOrderedSet.Create;
end;

destructor PExtensionManager.Destroy;
var
  Profile: PProfile;
begin
  FreeAndNil(FIncludedProfiles);
  for Profile in FAvailableProfiles do
    Profile.Free;
  FreeAndNil(FAvailableProfiles);
  inherited;
end;

function PExtensionManager.GetAvailableProfileCount: Integer;
begin
  Result := FAvailableProfiles.Count;
end;

function PExtensionManager.GetAvailableProfile(Index: Integer): PProfile;
begin
  Result := FAvailableProfiles.Items[Index];
end;

function PExtensionManager.GetIncludedProfileCount: Integer;
begin
  Result := FIncludedProfiles.Count;
end;

function PExtensionManager.GetIncludedProfile(Index: Integer): PProfile;
begin
  Result := FIncludedProfiles.Items[Index];
end;

function PExtensionManager.CanExcludeProfile(AProfile: PProfile): Boolean;
var
  MC: PMetaClass;
  T: PTaggedValue;
  I: Integer;
begin
  Result := True;
  MC := MetaModel.FindMetaClass('TaggedValue');
  for I := MC.InstanceCount - 1 downto 0 do begin
    T := MC.Instance[I] as PTaggedValue;
    if T.ProfileName = AProfile.Name then begin
      if (T.TaggedModel <> nil) and T.TaggedModel.ReadOnly then begin
        Result := False;
        Exit;
      end;
    // need not to check TTaggedValue.ReferenceValues
    end;
  end;
end;

procedure PExtensionManager.ClearIncludedProfiles;
begin
  ExcludeAllProfiles;
end;

procedure PExtensionManager.IncludeProfile(AProfileName: string);
var
  P: PProfile;
begin
  P := FindAvailableProfile(AProfileName);
  if P = nil then raise EProfileNotFound.Create(MSG_PROFILE_NOT_FOUND + ' (' + AProfileName + ')');
  FIncludedProfiles.Add(P);
end;

procedure PExtensionManager.ExcludeProfile(AProfileName: string);
var
  Idx: Integer;
begin
  Idx := FindIncludedProfileIdx(AProfileName);
  if Idx < 0 then
    raise EProfileNotFound.Create(MSG_PROFILE_NOT_FOUND + ' (' + AProfileName + ')');
  ExcludeProfile(Idx);
end;

procedure PExtensionManager.ExcludeProfile(AProfile: PProfile);
begin
  DoExcludeProfile(AProfile);
  FIncludedProfiles.Remove(AProfile);
end;

procedure PExtensionManager.ExcludeProfile(AProfileIdx: Integer);
var
  Profile: PProfile;
begin
  Assert((AProfileIdx >= 0) and (AProfileIdx < FIncludedProfiles.Count));
  Profile := FIncludedProfiles[AProfileIdx];
  DoExcludeProfile(Profile);
  FIncludedProfiles.Delete(AProfileIdx);
end;

// Do all actions associated with excluding profile
// without removing it from the list yet
procedure PExtensionManager.DoExcludeProfile(AProfile: PProfile);
var
  MC: PMetaClass;
  T: PTaggedValue;
  I: Integer;
begin
  // Check whether can exclude the profile.
  if not CanExcludeProfile(AProfile) then
    raise ECannotExcludeProfile.Create(MSG_PROFILE_CANNOT_EXCLUDE + ' (' + AProfile.Name + ')');

  // Delete all TaggedValues related to the Profile.
  MC := MetaModel.FindMetaClass('TaggedValue');
  for I := MC.InstanceCount - 1 downto 0 do begin
    T := MC.Instance[I] as PTaggedValue;
    if T.ProfileName = AProfile.Name then begin
      T.Isolate;
      T.Free;
    end;
  end;
end;


procedure PExtensionManager.ExcludeAllProfiles;
var
  Profile: PProfile;
begin
  for Profile in IncludedProfiles do
    DoExcludeProfile(Profile);
  IncludedProfiles.Clear;
end;

function PExtensionManager.IsIncluded(AProfile: PProfile): Boolean;
begin
  Result := (FIncludedProfiles.IndexOf(AProfile) > -1);
end;

function PExtensionManager.FindAvailableProfile(AName: string): PProfile;
var
  Profile: PProfile;
begin
  Result := nil;
  for Profile in FAvailableProfiles do
    if Profile.Name = AName then begin
      Result := Profile;
      Break;
    end;
end;

function PExtensionManager.FindIncludedProfileIdx(AName: string): Integer;
var
  I: Integer;
begin
  for I := 0 to IncludedProfileCount - 1 do begin
  if IncludedProfile[I].Name = AName then
    Break;
  end;
  if I < IncludedProfileCount then
    Result := I
  else
    Result := -1;
end;

function PExtensionManager.FindIncludedProfile(AName: string): PProfile;
var
  Profile: PProfile;
begin
  Result := nil;
  for Profile in FIncludedProfiles do begin
    if Profile.Name = AName then begin
      Result := Profile;
      Break;
    end;
  end;
end;

function PExtensionManager.FindStereotype(AProfile, AName: string; BaseClass: string): PStereotype;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindStereotype(AName, BaseClass);
end;

function PExtensionManager.FindFirstStereotype(Name: string; BaseClass: string): PStereotype;
var
  I: Integer;
  P: PProfile;
  S: PStereotype;
begin
  Result := nil;
  for I := 0 to IncludedProfileCount - 1 do begin
    P := IncludedProfile[I];
    S := P.FindStereotype(Name, BaseClass);
    if S <> nil then begin
      Result := S;
      Exit;
    end;
  end;
end;

function PExtensionManager.FindTagDefinition(AProfile, ATagDefinitionSetName, AName: string): PTagDefinition;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindTagDefinition(ATagDefinitionSetName, AName);
end;

function PExtensionManager.FindTagDefinitionSet(AProfile, AName: string): PTagDefinitionSet;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindTagDefinitionSet(AName);
end;

function PExtensionManager.FindDiagramType(AProfile, AName: string): PDiagramType;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindDiagramType(AName);
end;

function PExtensionManager.FindElementPrototype(AProfile, AName: string): PElementPrototype;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindElementPrototype(AName);
end;

function PExtensionManager.FindModelPrototype(AProfile, AName: string): PModelPrototype;
var
  P: PProfile;
begin
  Result := nil;
  P := FindIncludedProfile(AProfile);
  if P <> nil then
    Result := P.FindModelPrototype(AName);
end;

procedure PExtensionManager.LoadProfiles;

  function StringToBoolean(Value: string): Boolean;
  begin
    Result := (LowerCase(Value) = 'true');
  end;

  function AppendProfile(ProfileName, Path, FileName, IconFileName: string; AutoInclude: Boolean = False): Boolean;
  var
    PR: PProfileReader;
    P: PProfile;
  begin
    if not FileExists(FileName) then begin
      Result := False;
      Exit;
    end;
    P := PProfile.Create;
    P.FName := ProfileName; // will be overwrited in ReadProfile
    P.FPath := Path;
    P.FFileName := FileName;
    P.FIconFile := IconFileName;
    P.FAutoInclude := AutoInclude;
    PR := PProfileReader.Create;
    try
      if PR.ReadProfile(P) then begin
        FAvailableProfiles.Add(P);
        Result := True;
      end
      else begin
        P.Free;
        Result := False;
      end;
    finally
      PR.Free;
    end;
  end;

  procedure LoadFiles(Path: String);
  var
    SearchRec: TSearchRec;
    ProfileName, FolderPath, FileName, IconFileName: string;
    AutoInclude: Boolean;
  begin
    // files
    if FindFirst(Path + '\*' + PROFILE_EXTENSION, faArchive, SearchRec) = 0 then begin
      repeat
        ProfileName := Copy(SearchRec.Name, 1, Length(SearchRec.Name)-Length('.'+PROFILE_EXTENSION));
        FolderPath := Path;
        FileName := Path + '\' + ProfileName + '.' + PROFILE_EXTENSION;
        IconFileName := Path + '\' + ProfileName + '.' + ICON_EXTENSION;
        AutoInclude := false;

        if AppendProfile(ProfileName, FolderPath, FileName, IconFileName, AutoInclude) then
          LogManager.Log(Format(MSG_PROFILE_LOADED,[ProfileName]))
        else
          LogManager.Log(Format(ERR_PROFILE_LOAD_FAILED, [ProfileName]));
      until FindNext(SearchRec) <> 0;
    end;

    // folders
    if FindFirst(Path + '\*', faDirectory, SearchRec) = 0 then begin
      repeat
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          LoadFiles(Path + '\' + SearchRec.Name);
      until FindNext(SearchRec) <> 0;
    end;
  end;

begin
  FAvailableProfiles.Clear;
  LoadFiles(ExtractFileDir(Application.ExeName) + '\' + EXT_DIR);
end;

// PExtensionManager
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Utilities

function IsValidTagTypeStr(T: string): Boolean;
begin
  Result := (T = 'Integer') or (T = 'Boolean') or (T = 'String')
    or (T = 'Real') or (T = 'Enumeration') or (T = 'Reference') or (T = 'Collection');
end;

function TagTypeToStr(T: PTagTypeKind): string;
begin
  case T of
    tkInteger: Result := 'Integer';
    tkBoolean: Result := 'Boolean';
    tkString: Result := 'String';
    tkReal: Result := 'Real';
    tkEnumeration: Result := 'Enumeration';
    tkReference: Result := 'Reference';
    tkCollection: Result := 'Collection';
    else
      Result := 'String';
  end;
end;

function StrToTagType(T: string): PTagTypeKind;
begin
  if T = 'Integer' then
    Result := tkInteger
  else if T = 'Boolean' then
    Result := tkBoolean
  else if T = 'String' then
    Result := tkString
  else if T = 'Real' then
    Result := tkReal
  else if T = 'Enumeration' then
    Result := tkEnumeration
  else if T = 'Reference' then
    Result := tkReference
  else if T = 'Collection' then
    Result := tkCollection
  else
    Result := tkString;
end;

function IsDataTagType(T: PTagTypeKind): Boolean;
begin
  Result := (T = tkInteger) or (T = tkBoolean) or (T = tkString)
    or (T = tkReal) or (T = tkEnumeration);
end;

function IsReferenceTagType(T: PTagTypeKind): Boolean;
begin
  Result := (T = tkReference) or (T = tkCollection);
end;

function StrToDragType(T: string): PDragTypeKind;
begin
  if T = 'Rect' then
    Result := dkRect
  else if T = 'Line' then
    Result := dkLine
  else
    Result := dkRect;
end;

// Utilities
////////////////////////////////////////////////////////////////////////////////

procedure RegisterClasses;
begin
  ClassRegistry.RegisterClass(PExtensibleModel);
  ClassRegistry.RegisterClass(PConstraint);
  ClassRegistry.RegisterClass(PTaggedValue);
  ClassRegistry.RegisterClass(PProfile);
  ClassRegistry.RegisterClass(PTagDefinition);
  ClassRegistry.RegisterClass(PTagDefinitionSet);
  ClassRegistry.RegisterClass(PStereotype);
  ClassRegistry.RegisterClass(PDataType);
  ClassRegistry.RegisterClass(PElementPrototype);
  ClassRegistry.RegisterClass(PModelPrototype);
  ClassRegistry.RegisterClass(PPalette);
  ClassRegistry.RegisterClass(PDiagramType);
  ClassRegistry.RegisterClass(PExtensionManager);
end;

procedure RegisterMetaClasses;
var
  M: PMetaClass;
begin
  // Meta Classes
  MetaModel.DefineMetaClass(PExtensibleModel, 'ExtensibleModel', True);
  MetaModel.DefineMetaClass(PConstraint, 'Constraint', False);
  MetaModel.DefineMetaClass(PTaggedValue, 'TaggedValue', False);
  // ExtensibleModel
  M := MetaModel.FindMetaClass('ExtensibleModel');
  MetaModel.DefineMetaAttribute(M, 'StereotypeProfile', 'String', False, False);
  MetaModel.DefineMetaAttribute(M, 'StereotypeName', 'String', False, False);
  MetaModel.DefineMetaCollection(M, 'Constraints', 'Constraint', True, False, makComposite, 'ConstrainedModel', maeReference);
  MetaModel.DefineMetaCollection(M, 'TaggedValues', 'TaggedValue', True, False, makComposite, 'TaggedModel', maeReference);
  MetaModel.DefineMetaCollection(M, 'ReferencingTags', 'TaggedValue', True, False, makNone, 'ReferenceValues', maeCollection);
  // Constraint
  M := MetaModel.FindMetaClass('Constraint');
  MetaModel.DefineMetaAttribute(M, 'Name', 'String', False, False);
  MetaModel.DefineMetaAttribute(M, 'Body', 'String', False, False);
  MetaModel.DefineMetaReference(M, 'ConstrainedModel', 'ExtensibleModel', True, False, makNone, 'Constraints', maeCollection);
  // TaggedValue
  M := MetaModel.FindMetaClass('TaggedValue');
  MetaModel.DefineMetaAttribute(M, 'ProfileName', 'String', True, False);
  MetaModel.DefineMetaAttribute(M, 'TagDefinitionSetName', 'String', True, False);
  MetaModel.DefineMetaAttribute(M, 'Name', 'String', True, False);
  MetaModel.DefineMetaAttribute(M, 'DataValue', 'String', False, False);
  MetaModel.DefineMetaReference(M, 'TaggedModel', 'ExtensibleModel', True, False, makNone, 'TaggedValues', maeCollection);
  MetaModel.DefineMetaCollection(M, 'ReferenceValues', 'ExtensibleModel', True, False, makNone, 'ReferencingTags', maeCollection);
  // Inheritance Relations
  MetaModel.DefineMetaInheritance('Model', 'ExtensibleModel');
  MetaModel.DefineMetaInheritance('Element', 'Constraint');
  MetaModel.DefineMetaInheritance('Element', 'TaggedValue');
end;

initialization
  RegisterClasses;
  RegisterMetaClasses;
  ExtensionManager := PExtensionManager.Create;
finalization
  ExtensionManager.Free;
end.
