unit Core;

{******************************************************************************}
{                                                                              }
{                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. }
{******************************************************************************}

{******************************************************************************
                                      NOTE
 ------------------------------------------------------------------------------
 All Descendant of PElements satisfy below conditions (= Modeling Element)

 1. All attributes satisfy below coding convention.
   - property <Attr>:<Type> read Get...(or F...) write Set... (Getter/Setter)
 2. All references satisfy below coding convention.
   - property <Ref>:<Type> read Get... (or F...) write Set... (Getter/Setter)
 2. All collections satisfy below coding conventions.
   - property <Col>[Index: Integer]:<Type> read Get...; (only Getter)
   - property <Col>Count: Integer read Get...; (only Getter)
   - procedure Clear...
   - procedure Add...
   - procedure Remove...
   - procedure Insert...
   - procedure Delete...
   - function IndexOf...
 ******************************************************************************}

interface

uses
  BasicClasses, GraphicClasses,
  Graphics, Types, Classes, SysUtils, xmldom, XMLIntf, msxmldom, XMLDoc, ComObj,
  IniFiles;

const
  PATH_DELIMITER = '::';

  XPD_PREFIX = 'XPD';
  XPD_NAMESPACE_URI = 'http://www.staruml.com';
  XPD_HEADER = 'HEADER';
  XPD_BODY = 'BODY';
  XPD_OBJECT = 'OBJ';
  XPD_ATTRIBUTE = 'ATTR';
  XPD_REFERENCE = 'REF';
  XPD_DOCUMENT_ELEMENT = 'DocumentElement';
  XPD_NAME = 'name';
  XPD_PATHNAME = 'pathname';
  XPD_GUID = 'guid';
  XPD_TYPE = 'type';
  XPD_VERSION = 'version';
  XPD_INTEGER = 'integer';
  XPD_BOOLEAN = 'boolean';
  XPD_STRING = 'string';
  XPD_REAL = 'real';

  XPD_ERR_ATTRIBUTE_REQUIRED = '<ATTR> is required';
  XPD_ERR_OBJECT_REQUIRED = '<OBJ> is required';
  XPD_ERR_REFERENCE_REQUIRED = '<REF> is required';
  XPD_ERR_INVALID_INTEGER_TYPE = 'Invalid integer type';
  XPD_ERR_INVALID_BOOLEAN_TYPE = 'Invalid boolean type';
  XPD_ERR_INVALID_REAL_TYPE = 'Invalid real type';
  XPD_ERR_INVALID_STRING_TYPE = 'Invalid string type';
  XPD_ERR_INVALID_USERDEFINED_TYPE = 'Invalid user-defined type';

  DEFAULT_XML_VERSION = '1.0';
  DEFAULT_XML_ENCODING = 'UTF-8';
  MAX_ASYNC_LOAD_STATE = 4;

type
  // Forward Declarations
  PElement = class;
  PVisitor = class;
  PMemento = class;
  PModel = class;
  PView = class;
  PDiagram = class;
  PDiagramView = class;
  PDocument = class;

  // Exceptions
  EInvalidFileFormat = class(Exception);
  EFileNotFound = class(Exception);
  EReadOnlyFile = class(Exception);
  EMetaException = class(Exception);
  EMetaAttributeNotExist = class(EMetaException);
  EMetaReferenceNotExist = class(EMetaException);
  EMetaCollectionNotExist = class(EMetaException);
  EMetaClassifierNotExist = class(EMetaException);
  EInvalidName = class(Exception);
  EReadOnlyDocument = class(Exception);
  
  // Enumeration Types
  PMetaAggregateKind = (makNone, makAggregate, makComposite);
  PMetaAssociationEndKind = (maeReference, maeCollection);

  // Event Types
  PXMLObjectWriterFilter = procedure(Sender: TObject; CurrentObject: PObject; Key: string; var CanFilter: Boolean) of object;
  PElementEvent = procedure(Sender: TObject; Element: PElement) of object;
  PElementAttributeEvent = procedure(Sender: TObject; Element: PElement; Key, Value: string) of object;
  PElementsAttributeEvent = procedure(Sender: TObject; Elements: POrderedSet; Key, Value: string) of object;
  PElementReferenceEvent = procedure(Sender: TObject; Element: PElement; Key: string; Value: PElement) of object;
  PElementsReferenceEvent = procedure(Sender: TObject; Elements: POrderedSet; Key: string; Value: PElement) of object;
  PModelEvent = procedure(Sender: TObject; Model: PModel) of object;
  PViewEvent = procedure(Sender: TObject; View: PView) of object;
  PDiagramEvent = procedure(Sender: TObject; Diagram: PDiagram) of object;
  PModelsEvent = procedure(Sender: TObject; Models: POrderedSet) of object;
  PViewsEvent = procedure(Sender: TObject; Views: POrderedSet) of object;
  PModelsViewsEvent = procedure(Sender: TObject; Models: POrderedSet; Views: POrderedSet) of object;
  PModelNameEvent = procedure(Sender: TObject; Model: PModel; Name: string) of object;
  PProgressEvent = procedure(Sender: TObject; Info: string; Max, Progress: Integer) of object;
  PDocumentEvent = procedure(Sender: TObject; Document: PDocument) of object;

  // Class Types
  PElementClass = class of PElement;

  // PMetaElement
  PMetaElement = class(PObject)
  private
    FName: string;
  public
    constructor Create; override;
    property Name: string read FName write FName;
  end;

  // PMetaClassifier
  PMetaClassifier = class(PMetaElement)
  end;

  // PMetaSlot
  PMetaSlot = class(PMetaElement)
  private
    FTypeRef: PMetaClassifier;
    FIsReadOnly: Boolean;
    FIsDerived: Boolean;
  public
    property TypeRef: PMetaClassifier read FTypeRef write FTypeRef;
    property IsReadOnly: Boolean read FIsReadOnly write FIsReadOnly;
    property IsDerived: Boolean read FIsDerived write FIsDerived;
  end;

  // PMetaAttribute
  PMetaAttribute = class(PMetaSlot)
  private
    FDefaultValue: string;
  public
    property DefaultValue: string read FDefaultValue write FDefaultValue;
  end;

  // PMetaAssociationEnd
  PMetaAssociationEnd = class(PMetaSlot)
  private
    FKind: PMetaAssociationEndKind;
    FAggregate: PMetaAggregateKind;
    FOtherSide: string;
    FOtherSideKind: PMetaAssociationEndKind;
  public
    constructor Create; override;
    function GetOtherSideEnd: PMetaAssociationEnd;
    property Kind: PMetaAssociationEndKind read FKind;
    property Aggregate: PMetaAggregateKind read FAggregate write FAggregate;
    property OtherSide: string read FOtherSide write FOtherSide;
    property OtherSideKind: PMetaAssociationEndKind read FOtherSideKind write FOtherSideKind;
  end;

  // PMetaReference
  PMetaReference = class(PMetaAssociationEnd)
  public
    constructor Create; override;
  end;

  // PMetaCollection
  PMetaCollection = class(PMetaAssociationEnd)
  public
    constructor Create; override;
  end;

  // PMetaClass
  PMetaClass = class(PMetaClassifier)
  private
    FInstances: TList;
    FElementClass: PElementClass;
    FIsAbstract: Boolean;
    FMetaAttributes: TList;
    FMetaReferences: TList;
    FMetaCollections: TList;
    FSuperclass: PMetaClass;
    FSubclasses: TList;
    function GetOwnMetaAttribute(Index: Integer): PMetaAttribute;
    function GetOwnMetaAttributeCount: Integer;
    function GetOwnMetaReference(Index: Integer): PMetaReference;
    function GetOwnMetaReferenceCount: Integer;
    function GetOwnMetaCollection(Index: Integer): PMetaCollection;
    function GetOwnMetaCollectionCount: Integer;
    function GetMetaAttribute(Index: Integer): PMetaAttribute;
    function GetMetaAttributeCount: Integer;
    function GetMetaReference(Index: Integer): PMetaReference;
    function GetMetaReferenceCount: Integer;
    function GetMetaCollection(Index: Integer): PMetaCollection;
    function GetMetaCollectionCount: Integer;
    function GetInstance(Index: Integer): PElement;
    function GetInstanceCount: Integer;
    function GetInclusiveInstance(Index: Integer): PElement;
    function GetInclusiveInstanceCount: Integer;
    procedure SetSuperclass(Value: PMetaClass);
    function GetSubclass(Index: Integer): PMetaClass;
    function GetSubclassCount: Integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure ClearInstances;
    function CreateInstance(AGuid: string = ''): PElement;
    procedure DeleteInstance(AElement: PElement);
    function FindInstanceByGuid(AGuid: string): PElement;
    function FindInstanceByGuidRecurse(AGuid: string): PElement;
    function IsKindOf(AName: string): Boolean;
    function ExistsAttribute(Name: string): Boolean;
    function ExistsReference(Name: string): Boolean;
    function ExistsCollection(Name: string): Boolean;
    function GetAttributeByName(Name: string): PMetaAttribute;
    function GetReferenceByName(Name: string): PMetaReference;
    function GetCollectionByName(Name: string): PMetaCollection;
    function GetContainerRelation(Container: PMetaClass): PMetaReference;
    procedure Empty;
    procedure AddMetaAttribute(AMetaAttribute: PMetaAttribute);
    procedure RemoveMetaAttribute(AMetaAttribute: PMetaAttribute);
    procedure AddMetaReference(AMetaReference: PMetaReference);
    procedure RemoveMetaReference(AMetaReference: PMetaReference);
    procedure AddMetaCollection(AMetaCollection: PMetaCollection);
    procedure RemoveMetaCollection(AMetaCollection: PMetaCollection);
    property ElementClass: PElementClass read FElementClass write FElementClass;
    property IsAbstract: Boolean read FIsAbstract write FIsAbstract;
    property OwnMetaAttributes[Index: Integer]: PMetaAttribute read GetOwnMetaAttribute;
    property OwnMetaAttributeCount: Integer read GetOwnMetaAttributeCount;
    property OwnMetaReferences[Index: Integer]: PMetaReference read GetOwnMetaReference;
    property OwnMetaReferenceCount: Integer read GetOwnMetaReferenceCount;
    property OwnMetaCollections[Index: Integer]: PMetaCollection read GetOwnMetaCollection;
    property OwnMetaCollectionCount: Integer read GetOwnMetaCollectionCount;
    property MetaAttributes[Index: Integer]: PMetaAttribute read GetMetaAttribute;
    property MetaAttributeCount: Integer read GetMetaAttributeCount;
    property MetaReferences[Index: Integer]: PMetaReference read GetMetaReference;
    property MetaReferenceCount: Integer read GetMetaReferenceCount;
    property MetaCollections[Index: Integer]: PMetaCollection read GetMetaCollection;
    property MetaCollectionCount: Integer read GetMetaCollectionCount;
    property Instances[Index: Integer]: PElement read GetInstance;
    property InstanceCount: Integer read GetInstanceCount;
    property InclusiveInstances[Index: Integer]: PElement read GetInclusiveInstance;
    property InclusiveInstanceCount: Integer read GetInclusiveInstanceCount;
    property Superclass: PMetaClass read FSuperclass write SetSuperclass;
    property Subclasses[Index: Integer]: PMetaClass read GetSubclass;
    property SubclassCount: Integer read GetSubclassCount;
  end;

  // PMetaLiteral
  PMetaLiteral = class(PMetaElement)
  end;

  // PMetaEnumeration
  PMetaEnumeration = class(PMetaClassifier)
  private
    FMetaLiterals: TList;
    function GetMetaLiteral(Index: Integer): PMetaLiteral;
    function GetMetaLiteralCount: Integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Empty;
    procedure AddMetaLiteral(AMetaLiteral: PMetaLiteral);
    procedure RemoveMetaLiteral(AMetaLiteral: PMetaLiteral);
    property MetaLiterals[Index: Integer]: PMetaLiteral read GetMetaLiteral;
    property MetaLiteralCount: Integer read GetMetaLiteralCount;
  end;

  // PMetaPrimitiveType
  PMetaPrimitiveType = class(PMetaClassifier)
  end;

  // PMetaDataType
  PMetaDataType = class(PMetaClassifier)
  end;

  // PMetaModel
  PMetaModel = class(PMetaElement)
  private
    FMetaClasses: THashedStringList;
    FMetaPrimitiveTypes: THashedStringList;
    FMetaDataTypes: THashedStringList;
    FMetaEnumerations: THashedStringList;
    function GetMetaClass(Index: Integer): PMetaClass;
    function GetMetaClassCount: Integer;
    function GetMetaPrimitiveType(Index: Integer): PMetaPrimitiveType;
    function GetMetaPrimitiveTypeCount: Integer;
    function GetMetaDataType(Index: Integer): PMetaDataType;
    function GetMetaDataTypeCount: Integer;
    function GetMetaEnumeration(Index: Integer): PMetaEnumeration;
    function GetMetaEnumerationCount: Integer;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Empty;
    function IsKindOf(SubName, SuperName: string): Boolean;
    procedure ClearInstances;
    function CreateInstance(AMetaClassName: string; AGuid: string = ''): PElement;
    function FindInstanceByGuid(AGuid: string): PElement;
    procedure AddMetaClass(AMetaClass: PMetaClass);
    procedure RemoveMetaClass(AMetaClass: PMetaClass);
    function IndexOfMetaClass(AMetaClass: PMetaClass): Integer;
    procedure AddMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType);
    procedure RemoveMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType);
    function IndexOfMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType): Integer;
    procedure AddMetaDataType(AMetaDataType: PMetaDataType);
    procedure RemoveMetaDataType(AMetaDataType: PMetaDataType);
    function IndexOfMetaDataType(AMetaDataType: PMetaDataType): Integer;
    procedure AddMetaEnumeration(AMetaEnumeration: PMetaEnumeration);
    procedure RemoveMetaEnumeration(AMetaEnumeration: PMetaEnumeration);
    function IndexOfMetaEnumeration(AMetaEnumeration: PMetaEnumeration): Integer;
    function FindMetaClassifier(AName: string): PMetaClassifier;
    function FindMetaPrimitiveType(AName: string): PMetaPrimitiveType;
    function FindMetaDataType(AName: string): PMetaDataType;
    function FindMetaEnumeration(AName: string): PMetaEnumeration;
    function FindMetaClass(AName: string): PMetaClass;
    function DefineMetaPrimitiveType(AName: string): PMetaPrimitiveType;
    function DefineMetaDataType(AName: string): PMetaDataType;
    function DefineMetaEnumeration(AName: string): PMetaEnumeration;
    function DefineMetaClass(AElementClass: PElementClass; AName: string; Abst: Boolean): PMetaClass;
    procedure DefineMetaAttribute(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; ADefaultValue: string = '');
    procedure DefineMetaReference(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; Aggr: PMetaAggregateKind; OtherSide: string = ''; OtherSideKind: PMetaAssociationEndKind = maeReference);
    procedure DefineMetaCollection(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; Aggr: PMetaAggregateKind; OtherSide: string = ''; OtherSideKind: PMetaAssociationEndKind = maeReference);
    procedure DefineMetaLiteral(AMetaEnumeration: PMetaEnumeration; AName: string);
    procedure DefineMetaInheritance(SuperclassName, SubclassName: string);
    property MetaClasses[Index: Integer]: PMetaClass read GetMetaClass;
    property MetaClassCount: Integer read GetMetaClassCount;
    property MetaPrimitiveTypes[Index: Integer]: PMetaPrimitiveType read GetMetaPrimitiveType;
    property MetaPrimitiveTypeCount: Integer read GetMetaPrimitiveTypeCount;
    property MetaDataTypes[Index: Integer]: PMetaDataType read GetMetaDataType;
    property MetaDataTypeCount: Integer read GetMetaDataTypeCount;
    property MetaEnumerations[Index: Integer]: PMetaEnumeration read GetMetaEnumeration;
    property MetaEnumerationCount: Integer read GetMetaEnumerationCount;
  end;

  // PExtendedAttribute
  PExtendedAttribute = class
  private
    FKey: string;
    FValue: string;
    function GetAsInteger: Integer;
    function GetAsBoolean: Boolean;
    function GetAsFloat: Extended;
    procedure SetAsInteger(Value: Integer);
    procedure SetAsBoolean(Value: Boolean);
    procedure SetAsFloat(Value: Extended);
  public
    constructor Create(AKey, AValue: string);
    property Key: string read FKey write FKey;
    property Value: string read FValue write FValue;
    property AsString: string read FValue write FValue;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsFloat: Extended read GetAsFloat write SetAsFloat;
  end;

  // PElement
  PElement = class(PObject)
  private
    FTag: string;
    FMetaClass: PMetaClass;
    FDocument: PDocument;
    FExtendedAttributeList: TList;
    procedure SetTag(Value: string);
    function GetReadOnly: Boolean;
    procedure SetMetaClass(Value: PMetaClass);
    procedure SetDocument(Value: PDocument);
    function FindExtendedAttribute(Key: string): PExtendedAttribute;
    function GetExtendedAttribute(Key: string): PExtendedAttribute;
  protected
    // Follwing method is provision for changement in next version
    procedure BeforeStore(Reader: PObjectWriter); virtual;
    procedure BeforeLoad(Reader: PObjectReader); virtual;
    procedure AfterStore(Reader: PObjectWriter); virtual;
    procedure AfterLoad(Reader: PObjectReader); virtual;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    procedure Store(Writer: PObjectWriter); override;
    procedure Load(Reader: PObjectReader); override;
    procedure Isolate; virtual;
    procedure Accept(Visitor: PVisitor); virtual;
    function CreateMemento: PMemento; virtual;
    procedure SetMemento(Memento: PMemento);
    function IsDocumentElement: Boolean;
    function GetContainingDocument: PDocument; virtual;
    procedure ClearExtendedAttributes;
    function GetExtendedAttributeAt(Index: Integer): PExtendedAttribute;
    function GetExtendedAttributeCount: Integer;
    procedure AddExtendedAttribute(Key, Value: string);
    function MOF_GetAttribute(Name: string): string; virtual;
    procedure MOF_SetAttribute(Name, Value: string); virtual;
    function MOF_GetReference(Name: string): PElement; virtual;
    procedure MOF_SetReference(Name: string; Value: PElement); virtual;
    procedure MOF_AddCollectionItem(Name: string; Value: PElement); virtual;
    procedure MOF_RemoveCollectionItem(Name: string; Value: PElement); virtual;
    procedure MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement); virtual;
    procedure MOF_DeleteCollectionItem(Name: string; Index: Integer); virtual;
    procedure MOF_ClearCollection(Name: string); virtual;
    function MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer; virtual;
    function MOF_GetCollectionItem(Name: string; Index: Integer): PElement; virtual;
    function MOF_GetCollectionCount(Name: string): Integer; virtual;
    property Tag: string read FTag write SetTag;
    property ReadOnly: Boolean read GetReadOnly;
    property MetaClass: PMetaClass read FMetaClass write SetMetaClass;
    property Document: PDocument read FDocument write SetDocument;
    property ExtendedAttribute[Key: string]: PExtendedAttribute read GetExtendedAttribute;
  end;

  // PMemento
  PMemento = class
  private
    FMetaClass: PMetaClass;
    FDocument: PDocument;
    Attributes: TList;
    References: TList;
    Collections: TList;
    AttributeValues: TStringList;
    ReferenceValues: TList;
    ReferenceIndexes: TStringList;
    CollectionValues: TList;
    ExtendedAttributeKeys: TStringList;
    ExtendedAttributeValues: TStringList;
  protected
    procedure AssignFrom(Element: PElement); virtual;
    procedure AssignTo(Element: PElement); virtual;
  public
    constructor Create(Element: PElement); virtual;
    destructor Destroy; override;
  end;

  // PVisitor
  PVisitor = class
  public
    procedure Visit(Element: PElement); virtual; abstract;
  end;

  // PReferenceCollectionVisitor
  PReferenceCollectionVisitor = class(PVisitor)
  private
    FReferences: POrderedSet;
    function GetReference(Index: Integer): PObject;
    function GetReferenceCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Visit(Element: PElement); override;
    property References[Index: Integer]: PObject read GetReference;
    property ReferenceCount: Integer read GetReferenceCount;
  end;

  // PModel
  PModel = class(PElement)
  private
    FName: string;
    FDocumentation: string;
    FAttachments: TStringList;
    FViews: POrderedSet;
    FOwnedDiagrams: POrderedSet;
    FVirtualOwnedModels: POrderedSet;
    FVirtualNamespace: PModel;
    procedure SetName(Value: string);
    procedure SetDocumentation(Value: string);
    function GetPathname: string;
    function GetRootModel: PModel;
    function GetView(Index: Integer): PView;
    function GetViewCount: Integer;
    function GetOwnedDiagram(Index: Integer): PDiagram;
    function GetOwnedDiagramCount: Integer;
    function GetVirtualOwnedModel(Index: Integer): PModel;
    function GetVirtualOwnedModelCount: Integer;
    procedure SetVirtualNamespace(Value: PModel);
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Accept(Visitor: PVisitor); override;
    procedure ClearViews;
    procedure AddView(AView: PView);
    procedure RemoveView(AView: PView);
    procedure InsertView(Index: Integer; AView: PView);
    procedure DeleteView(Index: Integer);
    function IndexOfView(AView: PView): Integer;
    procedure UpdateViews;
    procedure ClearOwnedDiagrams;
    procedure AddOwnedDiagram(ADiagram: PDiagram);
    procedure RemoveOwnedDiagram(ADiagram: PDiagram);
    procedure InsertOwnedDiagram(Index: Integer; ADiagram: PDiagram);
    procedure DeleteOwnedDiagram(Index: Integer);
    function IndexOfOwnedDiagram(ADiagram: PDiagram): Integer;
    procedure AddVirtualOwnedModel(Model: PModel);
    procedure RemoveVirtualOwnedModel(Model: PModel);
    procedure InsertVirtualOwnedModel(Index: Integer; Model: PModel);
    function IndexOfVirtualOwnedModel(Model: PModel): Integer;
    function IsOneOfTheContainers(Model: PModel): Boolean;
    function GetContainerRelation(Container: PModel): PMetaReference; virtual;
    function CanContainKind(Kind: string): Boolean; virtual;
    function CanContain(Model: PModel): Boolean; virtual;
    function CanContainDiagramKind(Kind: string): Boolean; virtual;
    function CanContainDiagram(Diagram: PDiagram): Boolean; virtual;
    function CanRelocateTo(Model: PModel): Boolean; virtual;
    function CanCopy: Boolean; virtual;
    function CanDelete: Boolean; virtual;
    function CanPaste(Kind, CopyContext: string): Boolean; virtual;
    function ContainsName(AName: string): Boolean;
    function GenerateAvailableName(Model: PModel; Postfix: string = '_'): string;
    function FindByName(AName: string): PModel;
    function FindByRelativePathname(RelPath: string): PModel;
    function GetContainingDocument: PDocument; override;
    procedure ClearAttachments;
    procedure AddAttachment(Attach: string);
    procedure InsertAttachment(Index: Integer; Attach: string);
    procedure DeleteAttachment(Index: Integer);
    function GetAttachmentAt(Index: Integer): string;
    function GetAttachmentCount: 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 Name: string read FName write SetName;
    property Documentation: string read FDocumentation write SetDocumentation;
    property Attachments: TStringList read FAttachments;
    property Pathname: string read GetPathname;
    property RootModel: PModel read GetRootModel;
    property Views[Index: Integer]: PView read GetView;
    property ViewCount: Integer read GetViewCount;
    property OwnedDiagrams[Index: Integer]: PDiagram read GetOwnedDiagram;
    property OwnedDiagramCount: Integer read GetOwnedDiagramCount;
    property VirtualOwnedModels[Index: Integer]: PModel read GetVirtualOwnedModel;
    property VirtualOwnedModelCount: Integer read GetVirtualOwnedModelCount;
    property VirtualNamespace: PModel read FVirtualNamespace write SetVirtualNamespace;
  end;

  // PView
  // ---------------------------------------------------------------------------
  // Class for View
  // - use "OwnerDiagramView" property to get DiagramView
  // - use "GetDiagramView" function to get DiagramView in case which current view is Sub View
  // ---------------------------------------------------------------------------
  PView = class(PElement)
  private
    FModel: PModel;
    FParent: PView;
    FSubViews: POrderedSet;
    FContainerView: PView;
    FContainedViews: POrderedSet;
    FOwnerDiagramView: PDiagramView;
    FVisible: Boolean;
    FEnabled: Boolean;
    FSelected: Boolean;
    FSelectable: Boolean;
    FLineColor: TColor;
    FFillColor: TColor;
    FFontColor: TColor;
    FFontFace: string;
    FFontSize: Integer;
    FFontStyle: TFontStyles;
    FParentLineColor: Boolean;
    FParentFillColor: Boolean;
    FParentFontFace: Boolean;
    FParentFontSize: Boolean;
    FParentFontColor: Boolean;
    FParentFontStyle: Boolean;
    FContainerChangeable: Boolean;
    FContainerExtending: Boolean;
    procedure SetSelected(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetSelectable(Value: Boolean);
    function GetLineColor: TColor;
    procedure SetLineColor(Value: TColor);
    function GetFillColor: TColor;
    procedure SetFillColor(Value: TColor);
    function GetFontColor: TColor;
    procedure SetFontColor(Value: TColor);
    function GetFontFace: string;
    procedure SetFontFace(Value: string);
    function GetFontSize: Integer;
    procedure SetFontSize(Value: Integer);
    function GetFontStyle: TFontStyles;
    procedure SetFontStyle(Value: TFontStyles);
    procedure SetParentLineColor(Value: Boolean);
    procedure SetParentFillColor(Value: Boolean);
    procedure SetParentFontFace(Value: Boolean);
    procedure SetParentFontSize(Value: Boolean);
    procedure SetParentFontColor(Value: Boolean);
    procedure SetParentFontStyle(Value: Boolean);
    procedure SetModel(Value: PModel);
    procedure SetParent(Value: PView);
    function GetSubView(Index: Integer): PView;
    function GetSubViewCount: Integer;
    function GetContainedView(Index: Integer): PView;
    function GetContainedViewCount: Integer;
    procedure SetContainerView(Value: PView);
    procedure SetOwnerDiagramView(Value: PDiagramView);
    procedure SetContainerChangeable(Value: Boolean);
    procedure SetContainerExtending(Value: Boolean);
  protected
    procedure AssignStyleToCanvas(Canvas: PCanvas);
    procedure AssignFontToCanvas(Canvas: PCanvas);
    procedure DrawObject(Canvas: PCanvas); virtual;
    procedure DrawSelection(Canvas: PCanvas); virtual;
    procedure DrawNoModeledMark(Canvas: PCanvas); virtual;
    procedure MovePosition(Canvas: PCanvas; DX, DY: Integer); virtual;
    procedure ArrangeObject(Canvas: PCanvas); virtual;
    procedure DelimitContainingBoundary(Canvas: PCanvas); virtual;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Accept(Visitor: PVisitor); override;
    procedure Setup; virtual;
    procedure Initialize(Canvas: PCanvas; X1, Y1, X2, Y2: Integer); virtual;
    procedure Draw(Canvas: PCanvas); virtual;
    procedure Move(Canvas: PCanvas; DX, DY: Integer);
    procedure Arrange(Canvas: PCanvas); virtual;
    procedure Update; virtual;
    procedure BringToFront;
    procedure SendToBack;
    function GetContainingDocument: PDocument; override;
    function GetViewAt(Canvas: PCanvas; X, Y: Integer): PView; virtual;
    function GetDiagramView: PDiagramView;
    procedure ClearSubViews;
    procedure AddSubView(V: PView);
    procedure RemoveSubView(V: PView);
    procedure InsertSubView(Index: Integer; V: PView);
    procedure DeleteSubView(Index: Integer);
    function IndexOfSubView(V: PView): Integer;
    function IncludesSubView(V: PView): Boolean;
    procedure ClearContainedViews;
    procedure AddContainedView(V: PView);
    procedure RemoveContainedView(V: PView);
    procedure InsertContainedView(Index: Integer; V: PView);
    procedure DeleteContainedView(Index: Integer);
    function IndexOfContainedView(V: PView): Integer;
    function IsOneOfTheContainerViews(V: PView): Boolean;
    function CanContainViewKind(Kind: string): Boolean; virtual;
    function CanContainView(V: PView): Boolean;
    procedure DrawContainingBox(Canvas: PCanvas); virtual;
    procedure EraseContainingBox(Canvas: PCanvas); virtual;
    function GetBoundingBox(Canvas: PCanvas): TRect; virtual;
    function ContainsPoint(Canvas: PCanvas; P: TPoint): Boolean; overload; virtual;
    function ContainsPoint(Canvas: PCanvas; X, Y: Integer): Boolean; overload;
    function OverlapRect(Canvas: PCanvas; R: TRect): Boolean; overload; virtual;
    function OverlapRect(Canvas: PCanvas; X1, Y1, X2, Y2: Integer): Boolean; overload;
    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 Model: PModel read FModel write SetModel;
    property SubViews[Index: Integer]: PView read GetSubView;
    property SubViewCount: Integer read GetSubViewCount;
    property Parent: PView read FParent write SetParent;
    property ContainedViews[Index: Integer]: PView read GetContainedView;
    property ContainedViewCount: Integer read GetContainedViewCount;
    property ContainerView: PView read FContainerView write SetContainerView;
    property Visible: Boolean read FVisible write SetVisible;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Selected: Boolean read FSelected write SetSelected; // TRANSIENT //
    property Selectable: Boolean read FSelectable write SetSelectable; // TRANSIENT //
    property LineColor: TColor read GetLineColor write SetLineColor;
    property FillColor: TColor read GetFillColor write SetFillColor;
    property FontColor: TColor read GetFontColor write SetFontColor;
    property FontFace: string read GetFontFace write SetFontFace;
    property FontSize: Integer read GetFontSize write SetFontSize;
    property FontStyle: TFontStyles read GetFontStyle write SetFontStyle;
    property ParentLineColor: Boolean read FParentLineColor write SetParentLineColor; // TRANSIENT //
    property ParentFillColor: Boolean read FParentFillColor write SetParentFillColor; // TRANSIENT //
    property ParentFontFace: Boolean read FParentFontFace write SetParentFontFace; // TRANSIENT //
    property ParentFontSize: Boolean read FParentFontSize write SetParentFontSize; // TRANSIENT //
    property ParentFontColor: Boolean read FParentFontColor write SetParentFontColor; // TRANSIENT //
    property ParentFontStyle: Boolean read FParentFontStyle write SetParentFontStyle; // TRANSIENT //
    property OwnerDiagramView: PDiagramView read FOwnerDiagramView write SetOwnerDiagramView;
    property ContainerChangeable: Boolean read FContainerChangeable write SetContainerChangeable; // TRANSIENT //
    property ContainerExtending: Boolean read FContainerExtending write SetContainerExtending;  // TRANSIENT //    
  end;

  // PDiagram
  // ---------------------------------------------------------------------------
  // class plays Model role to contain diagram information
  // - don't use "Views" property but use "DiagramView" to get DiagramView
  // ---------------------------------------------------------------------------
  PDiagram = class(PModel)
  private
    FDefaultDiagram: Boolean;
    FDiagramType: string;
    FDiagramView: PDiagramView;
    FDiagramOwner: PModel;
    procedure SetDefaultDiagram(Value: Boolean);
    procedure SetDiagramType(Value: string);
    procedure SetDiagramView(Value: PDiagramView);
    procedure SetDiagramOwner(Value: PModel);
  public
    constructor Create; override;
    procedure Accept(Visitor: PVisitor); override;
    function GetContainingDocument: PDocument; override;
    function CanContainKind(Kind: string): Boolean; 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 DefaultDiagram: Boolean read FDefaultDiagram write SetDefaultDiagram;
    property DiagramType: string read FDiagramType write FDiagramType;
    property DiagramView: PDiagramView read FDiagramView write SetDiagramView;
    property DiagramOwner: PModel read FDiagramOwner write SetDiagramOwner;
  end;

  // PDiagramView
  // ---------------------------------------------------------------------------
  // is class to manage Views.
  // - Use "OwnedViews" to manage Contained Views, don't use SubViews
  // - don't use "Model" property but use "Diagram" to get Diagram model
  // ---------------------------------------------------------------------------
  PDiagramView = class(PView)
  private
    FDiagram: PDiagram;
    FCanvas: PCanvas;
    FOwnedViews: POrderedSet;
    FSelectedViews: POrderedSet;
    procedure SetDiagram(Value: PDiagram);
    function GetSelectedView(Index: Integer): PView;
    function GetSelectedCount: Integer;
    function GetOwnedView(Index: Integer): PView;
    function GetOwnedViewCount: Integer;
  protected
    procedure DrawObject(Canvas: PCanvas); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Accept(Visitor: PVisitor); override;
    procedure Draw(Canvas: PCanvas); override;
    procedure DrawDiagram(Canvas: PCanvas); virtual;
    procedure Update; override;
    function GetContainingDocument: PDocument; override;
    function GetViewAt(Canvas: PCanvas; X, Y: Integer): PView; override;
    function GetBottomViewAt(Canvas: PCanvas; X, Y: Integer): PView;
    function GetBoundingBox(Canvas: PCanvas): TRect; override;
    function GetSelectedBoundingBox(Canvas: PCanvas): TRect;
    function ContainsPoint(Canvas: PCanvas; P: TPoint): Boolean; override;
    function OverlapRect(Canvas: PCanvas; R: TRect): Boolean; override;
    procedure SelectAll;
    procedure DeselectAll;
    procedure SelectArea(Canvas: PCanvas; X1, Y1, X2, Y2: Integer);
    procedure ClearOwnedViews;
    procedure AddOwnedView(AView: PView);
    procedure RemoveOwnedView(AView: PView);
    procedure InsertOwnedView(Index: Integer; AView: PView);
    procedure DeleteOwnedView(Index: Integer);
    function IndexOfOwnedView(AView: PView): Integer;
    function CanOwnView(View: PView): Boolean; virtual;
    function CanOwnViewKind(Kind: string): Boolean; virtual;
    function CanCopyViews: Boolean; virtual;
    function CanDeleteViews: Boolean; virtual;
    function CanPasteViews(Kind, CopyContext: string): Boolean; virtual;
    function CanAcceptModel(Model: PModel): Boolean; virtual;
    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 Diagram: PDiagram read FDiagram write SetDiagram;
    property SelectedViews[Index: Integer]: PView read GetSelectedView;
    property SelectedViewCount: Integer read GetSelectedCount;
    property OwnedViews[Index: Integer]: PView read GetOwnedView;
    property OwnedViewCount: Integer read GetOwnedViewCount;
    property Canvas: PCanvas read FCanvas write FCanvas;
  end;

  // PReferenceResolveItem
  PReferenceResolveItem = class
  public
    Element: PElement;
    Name: string;
    GUID: string;
    Pathname: string;
    IsCollection: Boolean;
    constructor Create(AElement: PElement; AName, AGUID, APathname: string; AIsCollection: Boolean);
  end;

  // PReferenceResolver
  PReferenceResolver = class(TObject)
  private
    HashedGuidTable: THashedStringList;
    ResolveItemList: TList;
    CurProgress: Integer;
    ProgressMaxStep: Integer;
    FOnResolvingProgress: PProgressEvent;
    function GetResolveItem(Index: Integer): PReferenceResolveItem;
    function GetResolveItemCount: Integer;
    procedure ResolvingProgress(Info: string; Max, Progress: Integer);
    procedure BuildHashedGuidTable;
    function FindInstance(AGUID: string): PElement;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure AddResolveItem(AElement: PElement; AName, AGUID, APathname: string; AIsCollection: Boolean);
    procedure ResolveAll;
    procedure BlockedResolveAll(BaseElement: PElement);
    procedure ReplaceGUID(OldGUID, NewGUID: string);
    procedure ReassignGUIDs(BaseElement: PElement);
    property ResolveItems[Index: Integer]: PReferenceResolveItem read GetResolveItem;
    property ResolveItemCount: Integer read GetResolveItemCount;
    property OnResolvingProgress: PProgressEvent read FOnResolvingProgress
      write FOnResolvingProgress;
  end;

  // PXMLObjectReader
  PXMLObjectReader = class(PObjectReader)
  protected
    ReferenceResolver: PReferenceResolver;
    CurrentNode: IXMLNode;
    CurrentObject: PObject;
    CurrentKeyTable: THashedStringList;
    procedure CurrentBuildKeyTable(BaseNode: IXMLNode);
    function GetNodeByKey(Key: string): IXMLNode;
  public
    constructor Create(BaseNode: IXMLNode; AReferenceResolver: PReferenceResolver);
    destructor Destroy; override;
    function ReadInteger(Key: string; Default: Integer = 0): Integer; override;
    function ReadBoolean(Key: string; Default: Boolean = False): Boolean; override;
    function ReadReal(Key: string; Default: Real = 0.0): Real; override;
    function ReadString(Key: string; Default: string = ''): string; override;
    function ReadObject(Key: string; Default: PObject = nil): PObject; override;
    function ReadReference(Key: string; Default: PObject = nil): PObject; override;
    function ReadUserDefinedType(TypeName, Key: string; Default: string = ''): string; override;
  end;

  // PXMLObjectWriter
  PXMLObjectWriter = class(PObjectWriter)
  private
    FOnFilter: PXMLObjectWriterFilter;
    function GetAttrBeginNode(Name, TypeName: string): string;
    function GetAttrEndNode: string;
    function GetObjBeginNode(Name, TypeName, Guid: string): string;
    function GetObjEndNode: string;
  protected
    XMLStrings: TStrings;
    CurrentObject: PObject;
    CurrentDocument: PDocument;
    function GetRefBeginNode(Name: string; Pathname: string = ''): string;
    function GetRefEndNode: string;
    function IsFiltered(Key: string): Boolean;
  public
    constructor Create(AXMLStrings: TStrings);
    procedure WriteInteger(Key: string; Value: Integer; Default: Integer = 0); override;
    procedure WriteBoolean(Key: string; Value: Boolean; Default: Boolean = False); override;
    procedure WriteReal(Key: string; Value: Real; Default: Real = 0.0); override;
    procedure WriteString(Key: string; Value: string; Default: string = ''); override;
    procedure WriteObject(Key: string; Value: PObject; Default: PObject = nil); override;
    procedure WriteReference(Key: string; Value: PObject; Default: PObject = nil); override;
    procedure WriteUserDefinedType(TypeName, Key, Value: string; Default: string = ''); override;
    property OnFilter: PXMLObjectWriterFilter read FOnFilter write FOnFilter;
  end;

  // PXMLDOMObjectWriter
  PXMLDOMObjectWriter = class(PObjectWriter)
  protected
    CurrentNode: IXMLNode;
    CurrentObject: PObject;
    CurrentDocument: PDocument;
  public
    constructor Create(BaseNode: IXMLNode);
    procedure WriteInteger(Key: string; Value: Integer; Default: Integer = 0); override;
    procedure WriteBoolean(Key: string; Value: Boolean; Default: Boolean = False); override;
    procedure WriteReal(Key: string; Value: Real; Default: Real = 0.0); override;
    procedure WriteString(Key: string; Value: string; Default: string = ''); override;
    procedure WriteObject(Key: string; Value: PObject; Default: PObject = nil); override;
    procedure WriteReference(Key: string; Value: PObject; Default: PObject = nil); override;
    procedure WriteUserDefinedType(TypeName, Key, Value: string; Default: string = ''); override;
  end;

  // PDocument
  PDocument = class(PObject)
  private
    FFileName: string;
    FVersion: string;
    FReadOnly: Boolean;
    FModified: Boolean;
    FDocumentElement: PElement;
    FFileSavedTime: TDateTime;
    FExternallyModified: Boolean;
    FOnModified: PDocumentEvent;
    FOnSaved: PDocumentEvent;
    procedure SetModified(Value: Boolean);
    procedure SetDocumentElement(Value: PElement);
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure UpdateFileAttr;
    function GetDocumentSymbol: string; virtual;
    property FileName: string read FFileName write FFileName;
    property Version: string read FVersion write FVersion;
    property ReadOnly: Boolean read FReadOnly;
    property Modified: Boolean read FModified write SetModified;
    property FileSavedTime: TDateTime read FFileSavedTime write FFileSavedTime;
    property ExternallyModified: Boolean read FExternallyModified write FExternallyModified;
    property DocumentElement: PElement read FDocumentElement write SetDocumentElement;
    property OnModified: PDocumentEvent read FOnModified write FOnModified;
    property OnSaved: PDocumentEvent read FOnSaved write FOnSaved;
  end;

  // PDocumentInputStream
  PDocumentInputStream = class
  private
    FFileName: string;
    FReferenceResolver: PReferenceResolver;
    FOnLoadingProgress: PProgressEvent;
    procedure AsyncLoadHandler(Sender: TObject; AsyncLoadState: Integer);
    procedure LoadingProgress(Info: string; Max, Progress: Integer);
  protected
    XMLDoc: TXMLDocument;
    DocumentElement: PElement;
    function CreateDocument: PDocument; virtual; abstract;
    procedure ReadHeader(HeaderNode: IXMLNode); virtual;
    procedure ReadBody(BodyNode: IXMLNode); virtual;
  public
    constructor Create(AFileName: string; AReferenceResolver: PReferenceResolver); virtual;
    destructor Destroy; override;
    function ReadDocument: PDocument;
    property FileName: string read FFileName;
    property ReferenceResolver: PReferenceResolver read FReferenceResolver;
    property OnLoadingProgress: PProgressEvent read FOnLoadingProgress
      write FOnLoadingProgress;
  end;

  // PDocumentOutputStream
  PDocumentOutputStream = class
  private
    FFileName: string;
    FOnSavingProgress: PProgressEvent;
    function GetDocBeginNode: string;
    function GetDocEndNode: string;
    function GetHeaderBeginNode: string;
    function GetHeaderEndNode: string;
    function GetBodyBeginNode: string;
    function GetBodyEndNode: string;
    procedure SavingProgress(Info: string; Max, Progress: Integer);
    procedure FilterHandler(Sender: TObject; CurrentObject: PObject; Key: string; var CanFilter: Boolean);
  protected
    XMLStrings: TStrings;
    function GetDocumentSymbol: string; virtual;
    function GetDocumentVersion: Integer; virtual;
    procedure IsFiltered(Obj: PObject; Key: string; var CanFilter: Boolean); virtual;
    procedure WriteHeader(ADocument: PDocument); virtual;
    procedure WriteBody(ADocument: PDocument); virtual;
  public
    constructor Create(AFileName: string); virtual;
    destructor Destroy; override;
    procedure Close(ADocument: PDocument);
    procedure WriteDocument(ADocument: PDocument); virtual;
    property FileName: string read FFileName;
    property OnSavingProgress: PProgressEvent read FOnSavingProgress
      write FOnSavingProgress;
  end;

{
  // PDocumentOutputStream__
  PDocumentOutputStream__ = class
  private
    FFileName: string;
  protected
    XMLDoc: TXMLDocument;
    function GetDocumentSymbol: string; virtual;
    function GetDocumentVersion: Integer; virtual;
    procedure WriteHeader(HeaderNode: IXMLNode; ADocument: PDocument); virtual;
    procedure WriteBody(BodyNode: IXMLNode; ADocument: PDocument); virtual;
  public
    constructor Create(AFileName: string); virtual;
    destructor Destroy; override;
    procedure Close;
    procedure WriteDocument(ADocument: PDocument); virtual;
    property FileName: string read FFileName;
  end;
}

  // PrimitiveType Conversion Routines
  function BooleanToString(B: Boolean): string;
  function StringToBoolean(S: string): Boolean;
  function IntegerToString(I: Integer): string;
  function StringToInteger(S: string): Integer;
  function RealToString(R: Real): string;
  function StringToReal(S: string): Real;
  function RectToString(ARect: TRect): string;
  function StringToRect(RectStr: string): TRect;
  function ExtractHeadName(Pathname: string): string;
  function ExtractTailPath(Pathname: string): string;
  // Utility Functions
  procedure CheckNameValidity(Name: string);
  procedure CheckReadOnly(ElementSet: POrderedSet); overload;
  procedure CheckReadOnly(Element: PElement); overload;

var
  MetaModel: PMetaModel;

implementation

uses
  Windows, Variants, Forms, ComServ, HTTPApp, NLS_StarUML;

// -----------------------------------------------------------------------------
// IsCollectionKey
// - distincts that key is collection's key.
//   e.g. "OwnedElements[3]" ==> TRUE
//        "Classifier"       ==> FALSE
// -----------------------------------------------------------------------------
function IsCollectionKey(Key: string): Boolean;
begin
  Result := Copy(Trim(Key), Length(Trim(Key)), 1) = ']';
end;

// -----------------------------------------------------------------------------
// TrimCollectionKey
//   e.g. "OwnedElements[3]" ==> "OwnedElements"
// -----------------------------------------------------------------------------
function TrimCollectionKey(Key: string): string;
begin
  Result := Copy(Key, 1, Pos('[', Key) - 1); // cut '[number]'
end;

////////////////////////////////////////////////////////////////////////////////
// PMetaElement

constructor PMetaElement.Create;
begin
  inherited;
  FName := '';
end;

// PMetaElement
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaAssociationEnd

constructor PMetaAssociationEnd.Create;
begin
  inherited;
  FKind := maeReference;
  FAggregate := makNone;
  FOtherSide := '';
  FOtherSideKind := maeReference;
end;

function PMetaAssociationEnd.GetOtherSideEnd: PMetaAssociationEnd;
begin
  Result := nil;
  if TypeRef is PMetaClass then
    case OtherSideKind of
      maeReference: Result := (TypeRef as PMetaClass).GetReferenceByName(OtherSide);
      maeCollection: Result := (TypeRef as PMetaClass).GetCollectionByName(OtherSide);
    end;
end;

// PMetaAssociationEnd
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaReference

constructor PMetaReference.Create;
begin
  inherited;
  FKind := maeReference;
end;

// PMetaReference
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaCollection

constructor PMetaCollection.Create;
begin
  inherited;
  FKind := maeCollection;
end;

// PMetaCollection
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaClass

constructor PMetaClass.Create;
begin
  inherited;
  FInstances := TList.Create;
  FMetaAttributes := TList.Create;
  FMetaReferences := TList.Create;
  FMetaCollections := TList.Create;
  FSubclasses := TList.Create;
  FSuperclass := nil;
  FElementClass := nil;
end;

destructor PMetaClass.Destroy;
begin
  FInstances.Free;
  FInstances := nil;
  Empty;
  FMetaAttributes.Free;
  FMetaAttributes := nil;
  FMetaReferences.Free;
  FMetaReferences := nil;
  FMetaCollections.Free;
  FMetaCollections := nil;
  FSubclasses.Free;
  FSubclasses := nil;
  FSuperclass := nil;
  inherited;
end;

procedure PMetaClass.ClearInstances;
begin
  FInstances.Clear;
end;

function PMetaClass.GetOwnMetaAttribute(Index: Integer): PMetaAttribute;
begin
  Result := FMetaAttributes.Items[Index];
end;

function PMetaClass.GetOwnMetaAttributeCount: Integer;
begin
  Result := FMetaAttributes.Count;
end;

function PMetaClass.GetOwnMetaReference(Index: Integer): PMetaReference;
begin
  Result := FMetaReferences.Items[Index];
end;

function PMetaClass.GetOwnMetaReferenceCount: Integer;
begin
  Result := FMetaReferences.Count;
end;

function PMetaClass.GetOwnMetaCollection(Index: Integer): PMetaCollection;
begin
  Result := FMetaCollections.Items[Index];
end;

function PMetaClass.GetOwnMetaCollectionCount: Integer;
begin
  Result := FMetaCollections.Count;
end;

function PMetaClass.GetMetaAttribute(Index: Integer): PMetaAttribute;
begin
  if FSuperclass = nil then
    Result := FMetaAttributes.Items[Index]
  else begin
    if Index < FSuperclass.MetaAttributeCount then
      Result := FSuperclass.MetaAttributes[Index]
    else
      Result := FMetaAttributes.Items[Index - FSuperclass.MetaAttributeCount];
  end;
end;

function PMetaClass.GetMetaAttributeCount: Integer;
begin
  if FSuperclass = nil then
    Result := FMetaAttributes.Count
  else
    Result := Superclass.MetaAttributeCount + FMetaAttributes.Count;
end;

function PMetaClass.GetMetaReference(Index: Integer): PMetaReference;
begin
  if FSuperclass = nil then
    Result := FMetaReferences.Items[Index]
  else begin
    if Index < FSuperclass.MetaReferenceCount then
      Result := FSuperclass.MetaReferences[Index]
    else
      Result := FMetaReferences.Items[Index - FSuperclass.MetaReferenceCount];
  end;
end;

function PMetaClass.GetMetaReferenceCount: Integer;
begin
  if FSuperclass = nil then
    Result := FMetaReferences.Count
  else
    Result := FSuperclass.MetaReferenceCount + FMetaReferences.Count;
end;

function PMetaClass.GetMetaCollection(Index: Integer): PMetaCollection;
begin
  if FSuperclass = nil then
    Result := FMetaCollections.Items[Index]
  else begin
    if Index < FSuperclass.MetaCollectionCount then
      Result := FSuperclass.MetaCollections[Index]
    else
      Result := FMetaCollections.Items[Index - FSuperclass.MetaCollectionCount];
  end;
end;

function PMetaClass.GetMetaCollectionCount: Integer;
begin
  if FSuperclass = nil then
    Result := FMetaCollections.Count
  else
    Result := FSuperclass.MetaCollectionCount + FMetaCollections.Count;
end;

function PMetaClass.GetInstance(Index: Integer): PElement;
begin
  Result := FInstances.Items[Index];
end;

function PMetaClass.GetInstanceCount: Integer;
begin
  Result := FInstances.Count;
end;

function PMetaClass.GetInclusiveInstance(Index: Integer): PElement;
var
  I: Integer;
begin
  if Index < FInstances.Count then begin
    Result := FInstances.Items[Index];
    Exit;
  end
  else begin
    Index := Index - FInstances.Count;
    for I := 0 to SubclassCount - 1 do begin
      if Index < Subclasses[I].InclusiveInstanceCount then begin
        Result := Subclasses[I].InclusiveInstances[Index];
        Exit;
      end
      else begin
        Index := Index - Subclasses[I].InclusiveInstanceCount;
      end;
    end;
  end;
  Result := nil;
end;

function PMetaClass.GetInclusiveInstanceCount: Integer;
var
  I, C: Integer;
begin
  C := FInstances.Count;
  for I := 0 to SubclassCount - 1 do
    C := C + Subclasses[I].InclusiveInstanceCount;
  Result := C;
end;

procedure PMetaClass.SetSuperclass(Value: PMetaClass);
begin
  if FSuperclass <> Value then begin
    if FSuperclass <> nil then FSuperclass.FSubclasses.Remove(Self);
    FSuperclass := Value;
    if FSuperclass <>  nil then FSuperclass.FSubclasses.Add(Self);
  end;
end;

function PMetaClass.GetSubclass(Index: Integer): PMetaClass;
begin
  Result := FSubclasses.Items[Index];
end;

function PMetaClass.GetSubclassCount: Integer;
begin
  Result := FSubclasses.Count;
end;

function PMetaClass.CreateInstance(AGuid: string = ''): PElement;
var
  Elem: PElement;
begin
  Elem := FElementClass.Create;
  if AGuid <> '' then Elem.GUID := AGuid;
  Elem.MetaClass := Self;
  Result := Elem;
end;

procedure PMetaClass.DeleteInstance(AElement: PElement);
begin
  if AElement <> nil then AElement.MetaClass := nil;
end;

function PMetaClass.FindInstanceByGuid(AGuid: string): PElement;
var
  I: Integer;
  E: PElement;
begin
  Result := nil;
  for I := 0 to FInstances.Count - 1 do
  begin
    E := FInstances.Items[I];
    if E.GUID = AGuid then begin
      Result := E;
      Exit;
    end;
  end;
end;

function PMetaClass.FindInstanceByGuidRecurse(AGuid: string): PElement;
var
  E: PElement;
  I: Integer;
begin
  E := FindInstanceByGuid(AGuid);
  if E <> nil then
    Result := E
  else begin
    for I := 0 to SubclassCount - 1 do begin
      E := Subclasses[I].FindInstanceByGuidRecurse(AGuid);
      if E <> nil then begin
        Result := E;
        Exit;
      end;
    end;
    Result := nil;
  end;
end;

function PMetaClass.IsKindOf(AName: string): Boolean;
begin
  if Name = AName then begin
    Result := True;
  end
  else begin
    if Superclass = nil then
      Result := False
    else
      Result := Superclass.IsKindOf(AName);
  end;
end;

function PMetaClass.ExistsAttribute(Name: string): Boolean;
var
  I: Integer;
  A: PMetaAttribute;
begin
  for I := 0 to FMetaAttributes.Count - 1 do begin
    A := FMetaAttributes.Items[I];
    if A.Name = Name then begin
      Result := True;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.ExistsAttribute(Name)
  else
    Result := False;
end;

function PMetaClass.ExistsReference(Name: string): Boolean;
var
  I: Integer;
  R: PMetaReference;
begin
  for I := 0 to FMetaReferences.Count - 1 do begin
    R := FMetaReferences.Items[I];
    if R.Name = Name then begin
      Result := True;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.ExistsReference(Name)
  else
    Result := False;
end;

function PMetaClass.ExistsCollection(Name: string): Boolean;
var
  I: Integer;
  C: PMetaCollection;
begin
  for I := 0 to FMetaCollections.Count - 1 do begin
    C := FMetaCollections.Items[I];
    if C.Name = Name then begin
      Result := True;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.ExistsCollection(Name)
  else
    Result := False;
end;

function PMetaClass.GetAttributeByName(Name: string): PMetaAttribute;
var
  I: Integer;
  A: PMetaAttribute;
begin
  for I := 0 to FMetaAttributes.Count - 1 do begin
    A := FMetaAttributes.Items[I];
    if A.Name = Name then begin
      Result := A;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.GetAttributeByName(Name)
  else
    Result := nil;
end;

function PMetaClass.GetReferenceByName(Name: string): PMetaReference;
var
  I: Integer;
  R: PMetaReference;
begin
  for I := 0 to FMetaReferences.Count - 1 do begin
    R := FMetaReferences.Items[I];
    if R.Name = Name then begin
      Result := R;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.GetReferenceByName(Name)
  else
    Result := nil;
end;

function PMetaClass.GetCollectionByName(Name: string): PMetaCollection;
var
  I: Integer;
  C: PMetaCollection;
begin
  for I := 0 to FMetaCollections.Count - 1 do begin
    C := FMetaCollections.Items[I];
    if C.Name = Name then begin
      Result := C;
      Exit;
    end;
  end;
  if FSuperclass <> nil then
    Result := FSuperclass.GetCollectionByName(Name)
  else
    Result := nil;
end;

function PMetaClass.GetContainerRelation(Container: PMetaClass): PMetaReference;
var
  I: Integer;
  R: PMetaReference;
  OtherSide: PMetaAssociationEnd;
begin
  Result := nil;
  for I := 0 to OwnMetaReferenceCount - 1 do
  begin
    R := OwnMetaReferences[I];
    OtherSide := R.GetOtherSideEnd;
    if (OtherSide <> nil) and
       (OtherSide.Aggregate = makComposite) and
       Container.IsKindOf(R.TypeRef.Name) then
    begin
      Result := R;
      Exit;
    end;
  end;
  if Superclass <> nil then
    Result := Superclass.GetContainerRelation(Container);
end;

procedure PMetaClass.Empty;
var
  I: Integer;
  M: PMetaElement;
begin
  for I := FMetaAttributes.Count - 1 downto 0 do
  begin
    M := FMetaAttributes.Items[I];
    FMetaAttributes.Remove(M);
    M.Free;
  end;
  for I := FMetaReferences.Count - 1 downto 0 do
  begin
    M := FMetaReferences.Items[I];
    FMetaReferences.Remove(M);
    M.Free;
  end;
  for I := FMetaCollections.Count - 1 downto 0 do
  begin
    M := FMetaCollections.Items[I];
    FMetaCollections.Remove(M);
    M.Free;
  end;
end;

procedure PMetaClass.AddMetaAttribute(AMetaAttribute: PMetaAttribute);
begin
  FMetaAttributes.Add(AMetaAttribute);
end;

procedure PMetaClass.RemoveMetaAttribute(AMetaAttribute: PMetaAttribute);
begin
  FMetaAttributes.Remove(AMetaAttribute);
end;

procedure PMetaClass.AddMetaReference(AMetaReference: PMetaReference);
begin
  FMetaReferences.Add(AMetaReference);
end;

procedure PMetaClass.RemoveMetaReference(AMetaReference: PMetaReference);
begin
  FMetaReferences.Remove(AMetaReference);
end;

procedure PMetaClass.AddMetaCollection(AMetaCollection: PMetaCollection);
begin
  FMetaCollections.Add(AMetaCollection);
end;

procedure PMetaClass.RemoveMetaCollection(AMetaCollection: PMetaCollection);
begin
  FMetaCollections.Remove(AMetaCollection);
end;

// PMetaClass
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaEnumeration

constructor PMetaEnumeration.Create;
begin
  inherited;
  FMetaLiterals := TList.Create;
end;

destructor PMetaEnumeration.Destroy;
begin
  Empty;
  FMetaLiterals.Free;
  FMetaLiterals := nil;
  inherited;
end;

function PMetaEnumeration.GetMetaLiteral(Index: Integer): PMetaLiteral;
begin
  Result := FMetaLiterals.Items[Index];
end;

function PMetaEnumeration.GetMetaLiteralCount: Integer;
begin
  Result := FMetaLiterals.Count;
end;

procedure PMetaEnumeration.Empty;
var
  I: Integer;
  M: PMetaElement;
begin
  for I := FMetaLiterals.Count - 1 downto 0 do
  begin
    M := FMetaLiterals.Items[I];
    FMetaLiterals.Remove(M);
    M.Free;
  end;
end;

procedure PMetaEnumeration.AddMetaLiteral(AMetaLiteral: PMetaLiteral);
begin
  FMetaLiterals.Add(AMetaLiteral)
end;

procedure PMetaEnumeration.RemoveMetaLiteral(AMetaLiteral: PMetaLiteral);
begin
  FMetaLiterals.Remove(AMetaLiteral);
end;

// PMetaEnumeration
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMetaModel

constructor PMetaModel.Create;
begin
  inherited;
  FMetaClasses := THashedStringList.Create;
  FMetaClasses.CaseSensitive := True;
  FMetaPrimitiveTypes := THashedStringList.Create;
  FMetaPrimitiveTypes.CaseSensitive := True;
  FMetaDataTypes := THashedStringList.Create;
  FMetaDataTypes.CaseSensitive := True;
  FMetaEnumerations := THashedStringList.Create;
  FMetaEnumerations.CaseSensitive := True;
end;

destructor PMetaModel.Destroy;
begin
  Empty;
  FMetaClasses.Free;
  FMetaClasses := nil;
  FMetaPrimitiveTypes.Free;
  FMetaPrimitiveTypes := nil;
  FMetaDataTypes.Free;
  FMetaDataTypes := nil;
  FMetaEnumerations.Free;
  FMetaEnumerations := nil;
  inherited;
end;

function PMetaModel.GetMetaClass(Index: Integer): PMetaClass;
begin
  Result := FMetaClasses.Objects[Index] as PMetaClass;
end;

function PMetaModel.GetMetaClassCount: Integer;
begin
  Result := FMetaClasses.Count;
end;

function PMetaModel.GetMetaPrimitiveType(Index: Integer): PMetaPrimitiveType;
begin
  Result := FMetaPrimitiveTypes.Objects[Index] as PMetaPrimitiveType;
end;

function PMetaModel.GetMetaPrimitiveTypeCount: Integer;
begin
  Result := FMetaPrimitiveTypes.Count;
end;

function PMetaModel.GetMetaDataType(Index: Integer): PMetaDataType;
begin
  Result := FMetaDataTypes.Objects[Index] as PMetaDataType;
end;

function PMetaModel.GetMetaDataTypeCount: Integer;
begin
  Result := FMetaDataTypes.Count;
end;

function PMetaModel.GetMetaEnumeration(Index: Integer): PMetaEnumeration;
begin
  Result := FMetaEnumerations.Objects[Index] as PMetaEnumeration;
end;

function PMetaModel.GetMetaEnumerationCount: Integer;
begin
  Result := FMetaEnumerations.Count;
end;

procedure PMetaModel.Empty;
var
  I: Integer;
  M: PMetaElement;
begin
  for I := FMetaClasses.Count - 1 downto 0 do
  begin
    M := FMetaClasses.Objects[I] as PMetaElement;
    FMetaClasses.Delete(I);
    M.Free;
  end;
  for I := FMetaPrimitiveTypes.Count - 1 downto 0 do
  begin
    M := FMetaPrimitiveTypes.Objects[I] as PMetaElement;
    FMetaPrimitiveTypes.Delete(I);
    M.Free;
  end;
  for I := FMetaDataTypes.Count - 1 downto 0 do
  begin
    M := FMetaDataTypes.Objects[I] as PMetaElement;
    FMetaDataTypes.Delete(I);
    M.Free;
  end;
  for I := FMetaEnumerations.Count - 1 downto 0 do
  begin
    M := FMetaEnumerations.Objects[I] as PMetaElement;
    FMetaEnumerations.Delete(I);
    M.Free;
  end;
end;

function PMetaModel.IsKindOf(SubName, SuperName: string): Boolean;
var
  MC: PMetaClass;
begin
  MC := FindMetaClass(SubName);
  if MC <> nil then
    Result := MC.IsKindOf(SuperName)
  else
    Result := False;
end;

procedure PMetaModel.ClearInstances;
var
  I: Integer;
  M: PMetaClass;
begin
  for I := FMetaClasses.Count - 1 downto 0 do
  begin
    M := FMetaClasses.Objects[I] as PMetaClass;
    M.ClearInstances;
  end;
end;

function PMetaModel.CreateInstance(AMetaClassName: string; AGuid: string = ''): PElement;
var
  M: PMetaClass;
begin
  M := FindMetaClass(AMetaClassName);
  if M = nil then raise EMetaClassifierNotExist.Create('MetaClass not found (' + AMetaClassName + ')');
  Result := M.CreateInstance(AGuid);
end;

function PMetaModel.FindInstanceByGuid(AGuid: string): PElement;
var
  I: Integer;
  Instance: PElement;
begin
  for I := 0 to MetaClassCount - 1 do
  begin
    Instance := MetaClasses[I].FindInstanceByGuid(AGuid);
    if Instance <> nil then begin
      Result := Instance;
      Exit;
    end;
  end;
  Result := nil;
end;

procedure PMetaModel.AddMetaClass(AMetaClass: PMetaClass);
begin
  FMetaClasses.AddObject(AMetaClass.Name, AMetaClass);
end;

procedure PMetaModel.RemoveMetaClass(AMetaClass: PMetaClass);
begin
  FMetaClasses.Delete(FMetaClasses.IndexOfObject(AMetaClass));
end;

function PMetaModel.IndexOfMetaClass(AMetaClass: PMetaClass): Integer;
begin
  Result := FMetaClasses.IndexOfObject(AMetaClass);
end;

procedure PMetaModel.AddMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType);
begin
  FMetaPrimitiveTypes.AddObject(AMetaPrimitiveType.Name, AMetaPrimitiveType)
end;

procedure PMetaModel.RemoveMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType);
begin
  FMetaPrimitiveTypes.Delete(FMetaPrimitiveTypes.IndexOfObject(AMetaPrimitiveType));
end;

function PMetaModel.IndexOfMetaPrimitiveType(AMetaPrimitiveType: PMetaPrimitiveType): Integer;
begin
  Result := FMetaPrimitiveTypes.IndexOfObject(AMetaPrimitiveType);
end;

procedure PMetaModel.AddMetaDataType(AMetaDataType: PMetaDataType);
begin
  FMetaDataTypes.AddObject(AMetaDataType.Name, AMetaDataType);
end;

procedure PMetaModel.RemoveMetaDataType(AMetaDataType: PMetaDataType);
begin
  FMetaDataTypes.Delete(FMetaDataTypes.IndexOfObject(AMetaDataType));
end;

function PMetaModel.IndexOfMetaDataType(AMetaDataType: PMetaDataType): Integer;
begin
  Result := FMetaDataTypes.IndexOfObject(AMetaDataType);
end;

procedure PMetaModel.AddMetaEnumeration(AMetaEnumeration: PMetaEnumeration);
begin
  FMetaEnumerations.AddObject(AMetaEnumeration.Name, AMetaEnumeration);
end;

procedure PMetaModel.RemoveMetaEnumeration(AMetaEnumeration: PMetaEnumeration);
begin
  FMetaEnumerations.Delete(FMetaEnumerations.IndexOfObject(AMetaEnumeration));
end;

function PMetaModel.IndexOfMetaEnumeration(AMetaEnumeration: PMetaEnumeration): Integer;
begin
  Result := FMetaEnumerations.IndexOfObject(AMetaEnumeration);
end;

function PMetaModel.FindMetaClassifier(AName: string): PMetaClassifier;
var
  M: PMetaClassifier;
begin
  M := FindMetaPrimitiveType(AName);
  if M = nil then M := FindMetaDataType(AName);
  if M = nil then M := FindMetaEnumeration(AName);
  if M = nil then M := FindMetaClass(AName);
  Result := M;
end;

function PMetaModel.FindMetaPrimitiveType(AName: string): PMetaPrimitiveType;
var
  Idx: Integer;
begin
  Idx := FMetaPrimitiveTypes.IndexOf(AName);
  if Idx < 0 then
    Result := nil
  else
    Result := FMetaPrimitiveTypes.Objects[Idx] as PMetaPrimitiveType;
end;

function PMetaModel.FindMetaDataType(AName: string): PMetaDataType;
var
  Idx: Integer;
begin
  Idx := FMetaDataTypes.IndexOf(AName);
  if Idx < 0 then
    Result := nil
  else
    Result := FMetaDataTypes.Objects[Idx] as PMetaDataType;
end;

function PMetaModel.FindMetaEnumeration(AName: string): PMetaEnumeration;
var
  Idx: Integer;
begin
  Idx := FMetaEnumerations.IndexOf(AName);
  if Idx < 0 then
    Result := nil
  else
    Result := FMetaEnumerations.Objects[Idx] as PMetaEnumeration;
end;

function PMetaModel.FindMetaClass(AName: string): PMetaClass;
var
  Idx: Integer;
begin
  Idx := FMetaClasses.IndexOf(AName);
  if Idx < 0 then
    Result := nil
  else
    Result := FMetaClasses.Objects[Idx] as PMetaClass;
end;

function PMetaModel.DefineMetaPrimitiveType(AName: string): PMetaPrimitiveType;
var
  M: PMetaPrimitiveType;
begin
  M := PMetaPrimitiveType.Create;
  M.Name := AName;
  AddMetaPrimitiveType(M);
  Result := M;
end;

function PMetaModel.DefineMetaDataType(AName: string): PMetaDataType;
var
  M: PMetaDataType;
begin
  M := PMetaDataType.Create;
  M.Name := AName;
  AddMetaDataType(M);
  Result := M;
end;

function PMetaModel.DefineMetaEnumeration(AName: string): PMetaEnumeration;
var
  M: PMetaEnumeration;
begin
  M := PMetaEnumeration.Create;
  M.Name := AName;
  AddMetaEnumeration(M);
  Result := M;
end;

function PMetaModel.DefineMetaClass(AElementClass: PElementClass; AName: string; Abst: Boolean): PMetaClass;
var
  M: PMetaClass;
begin
  M := PMetaClass.Create;
  M.Name := AName;
  M.ElementClass := AElementClass;
  M.IsAbstract := Abst;
  AddMetaClass(M);
  Result := M;
end;

procedure PMetaModel.DefineMetaAttribute(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; ADefaultValue: string = '');
var
  M: PMetaAttribute;
begin
  M := PMetaAttribute.Create;
  M.Name := AName;
  M.TypeRef := FindMetaClassifier(ATypeName);
  M.IsReadOnly := AReadOnly;
  M.IsDerived := ADerived;
  if ADefaultValue = '' then begin
    if M.TypeRef.Name = 'Integer' then
      M.DefaultValue := '0'
    else if M.TypeRef.Name = 'Boolean' then
      M.DefaultValue := 'False'
    else if M.TypeRef.Name = 'String' then
      M.DefaultValue := ''
    else if M.TypeRef.Name = 'Real' then
      M.DefaultValue := '0'
    else
      M.DefaultValue := '';
  end
  else
    M.DefaultValue := ADefaultValue;
  AMetaClass.AddMetaAttribute(M);
end;

procedure PMetaModel.DefineMetaReference(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; Aggr: PMetaAggregateKind; OtherSide: string = ''; OtherSideKind: PMetaAssociationEndKind = maeReference);
var
  M: PMetaReference;
begin
  M := PMetaReference.Create;
  M.Name := AName;
  M.TypeRef := FindMetaClassifier(ATypeName);
  M.IsReadOnly := AReadOnly;
  M.IsDerived := ADerived;
  M.Aggregate := Aggr;
  M.OtherSide := OtherSide;
  M.OtherSideKind := OtherSideKind;
  AMetaClass.AddMetaReference(M);
end;

procedure PMetaModel.DefineMetaCollection(AMetaClass: PMetaClass; AName, ATypeName: string; AReadOnly, ADerived: Boolean; Aggr: PMetaAggregateKind; OtherSide: string = ''; OtherSideKind: PMetaAssociationEndKind = maeReference);
var
  M: PMetaCollection;
begin
  M := PMetaCollection.Create;
  M.Name := AName;
  M.TypeRef := FindMetaClassifier(ATypeName);
  M.IsReadOnly := AReadOnly;
  M.IsDerived := ADerived;
  M.Aggregate := Aggr;
  M.OtherSide := OtherSide;
  M.OtherSideKind := OtherSideKind;
  AMetaClass.AddMetaCollection(M);
end;

procedure PMetaModel.DefineMetaLiteral(AMetaEnumeration: PMetaEnumeration; AName: string);
var
  M: PMetaLiteral;
begin
  M := PMetaLiteral.Create;
  M.Name := AName;
  AMetaEnumeration.AddMetaLiteral(M);
end;

procedure PMetaModel.DefineMetaInheritance(SuperclassName, SubclassName: string);
begin
  FindMetaClass(SubclassName).Superclass := FindMetaClass(SuperclassName);
end;

// PMetaModel
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PExtendedAttribute

constructor PExtendedAttribute.Create(AKey, AValue: string);
begin
  inherited Create;
  FKey := AKey;
  FValue := AValue;
end;

function PExtendedAttribute.GetAsInteger: Integer;
var
  Val: Integer;
begin
  if Trim(FValue) = '' then
  begin
    Result := 0;
    Exit;
  end;
  try
    Val := StrToInt(FValue);
  except
    Val := 0;
  end;
  Result := Val;
end;

function PExtendedAttribute.GetAsBoolean: Boolean;
var
  Val: Boolean;
begin
  if Trim(FValue) = '' then
  begin
    Result := False;
    Exit;
  end;
  try
    Val := StrToBool(FValue);
  except
    Val := False;
  end;
  Result := Val;
end;

function PExtendedAttribute.GetAsFloat: Extended;
var
  Val: Extended;
begin
  if Trim(FValue) = '' then
  begin
    Result := 0.0;
    Exit;
  end;
  try
    Val := StrToFloat(FValue);
  except
    Val := 0.0;
  end;
  Result := Val;
end;

procedure PExtendedAttribute.SetAsInteger(Value: Integer);
begin
  FValue := IntToStr(Value);
end;

procedure PExtendedAttribute.SetAsBoolean(Value: Boolean);
begin
  FValue := BoolToStr(Value);
end;

procedure PExtendedAttribute.SetAsFloat(Value: Extended);
begin
  FValue := FloatToStr(Value);
end;

// PExtendedAttribute
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PElement

constructor PElement.Create;
begin
  inherited;
  FMetaClass := nil;
  FDocument := nil;
  FExtendedAttributeList := TList.Create;
end;

destructor PElement.Destroy;
begin
  Document := nil;
  MetaClass := nil;
  FExtendedAttributeList.Free;
  inherited;
end;

procedure PElement.BeforeDestruction;
var
  I, J: Integer;
  R: PMetaReference;
  C: PMetaCollection;
  E: PElement;
begin
  inherited;
  // Free sub objects
  if MetaClass <> nil then begin
    for I := 0 to MetaClass.MetaReferenceCount - 1 do
    begin
      R := MetaClass.MetaReferences[I];
      if R.Aggregate = makComposite then
      begin
        E := MOF_GetReference(R.Name);
        MOF_SetReference(R.Name, nil);
        E.Free;
      end
      else begin
        MOF_SetReference(R.Name, nil);
      end;
    end;
    for I := 0 to MetaClass.MetaCollectionCount - 1 do
    begin
      C := MetaClass.MetaCollections[I];
      if C.Aggregate = makComposite then
      begin
        for J := MOF_GetCollectionCount(C.Name) - 1 downto 0 do
        begin
          E := MOF_GetCollectionItem(C.Name, J);
          MOF_RemoveCollectionItem(C.Name, E);
          E.Free;
        end;
        MOF_ClearCollection(C.Name);
      end
      else begin
        MOF_ClearCollection(C.Name);
      end;
    end;
  end;
end;

procedure PElement.SetTag(Value: string);
begin
  if FTag <> Value then begin
    FTag := Value;
  end;
end;

function PElement.GetReadOnly: Boolean;
var
  D: PDocument;
begin
  D := GetContainingDocument;
  if D <> nil then
    Result := D.ReadOnly
  else
    Result := False;
end;

procedure PElement.SetMetaClass(Value: PMetaClass);
begin
  if FMetaClass <> Value then begin
    if FMetaClass <> nil then
      FMetaClass.Finstances.Remove(Self);
    FMetaClass := Value;
    if FMetaClass <> nil then
      FMetaClass.FInstances.Add(Self);
  end;
end;

procedure PElement.SetDocument(Value: PDocument);
begin
  if FDocument <> Value then begin
    if FDocument <> nil then FDocument.FDocumentElement := nil;
    FDocument := Value;
    if FDocument <> nil then FDocument.FDocumentElement := Self;
  end;
end;

function PElement.FindExtendedAttribute(Key: string): PExtendedAttribute;
var
  I: Integer;
  EA: PExtendedAttribute;
begin
  for I := 0 to FExtendedAttributeList.Count - 1 do
  begin
    EA := FExtendedAttributeList.Items[I];
    if Trim(EA.Key) = Trim(Key) then
    begin
      Result := EA;
      Exit;
    end;
  end;
  Result := nil;
end;

function PElement.GetExtendedAttribute(Key: string): PExtendedAttribute;
var
  EA: PExtendedAttribute;
begin
  EA := FindExtendedAttribute(Key);
  if EA <> nil then
    Result := EA
  else begin
    EA := PExtendedAttribute.Create(Key, '');
    FExtendedAttributeList.Add(EA);
    Result := EA;
  end;
end;

procedure PElement.BeforeStore(Reader: PObjectWriter);
begin
// Reserved for next version.
end;

procedure PElement.BeforeLoad(Reader: PObjectReader);
begin
// Reserved for next version.
end;

procedure PElement.AfterStore(Reader: PObjectWriter);
begin
// Reserved for next version.
end;

procedure PElement.AfterLoad(Reader: PObjectReader);
begin
// Reserved for next version.
end;

procedure PElement.Store(Writer: PObjectWriter);
var
  I, J, Cnt: Integer;
  A: PMetaAttribute;
  R: PMetaReference;
  C: PMetaCollection;
  E: PElement;
  L: TList;
  EA: PExtendedAttribute;
  DefaultInteger: Integer;
  DefaultBoolean: Boolean;
  DefaultReal: Extended;
  DefaultString: string;
begin
  inherited;
  BeforeStore(Writer);
  // Store Attributes
  for I := 0 to MetaClass.MetaAttributeCount - 1 do begin
    A := MetaClass.MetaAttributes[I];
    if not A.IsDerived then begin
      // - Storing Integer Value
      if A.TypeRef.Name = 'Integer' then begin
        try
          DefaultInteger := StrToInt(A.DefaultValue);
        except
          DefaultInteger := 0;
        end;
        Writer.WriteInteger(A.Name, StringToInteger(MOF_GetAttribute(A.Name)), DefaultInteger);
      end
      // - Storing Boolean Value
      else if A.TypeRef.Name = 'Boolean' then begin
        try
          DefaultBoolean := StrToBool(A.DefaultValue);
        except
          DefaultBoolean := False;
        end;
        Writer.WriteBoolean(A.Name, StringToBoolean(MOF_GetAttribute(A.Name)), DefaultBoolean);
      end
      // - Storing Real Value
      else if A.TypeRef.Name = 'Real' then begin
        try
          DefaultReal := StrToFloat(A.DefaultValue);
        except
          DefaultReal := 0.0;
        end;
        Writer.WriteReal(A.Name, StringToReal(MOF_GetAttribute(A.Name)), DefaultReal);
      end
      // - Storing String Value
      else if A.TypeRef.Name = 'String' then begin
        DefaultString := A.DefaultValue;
        Writer.WriteString(A.Name, MOF_GetAttribute(A.Name), DefaultString);
      end
      // - Storing UserDefined Value
      else begin
        DefaultString := A.DefaultValue;
        Writer.WriteUserDefinedType(A.TypeRef.Name, A.Name, MOF_GetAttribute(A.Name), DefaultString);
      end;
    end;
  end;
  // Store References
  for I := 0 to MetaClass.MetaReferenceCount - 1 do begin
    R := MetaClass.MetaReferences[I];
    if not R.IsDerived then begin
      E := MOF_GetReference(R.Name);
      if R.Aggregate = makComposite then begin
        if (E <> nil) and E.IsDocumentElement then begin
          // if Stored Object is DocumentElement, don't save
        end
        else begin
          Writer.WriteObject(R.Name, MOF_GetReference(R.Name))
        end;
      end
      else begin
        Writer.WriteReference(R.Name, MOF_GetReference(R.Name));
      end;
    end;
  end;
  // Store Collections
  L := TList.Create;
  for I := 0 to MetaClass.MetaCollectionCount - 1 do begin
    C := MetaClass.MetaCollections[I];
    if not C.IsDerived then begin
      Cnt := MOF_GetCollectionCount(C.Name);
      if C.Aggregate = makComposite then begin
        // gather to list L objects which are not DocumentElement
        L.Clear;
        for J := 0 to Cnt - 1 do begin
          E := MOF_GetCollectionItem(C.Name, J);
          if (E <> nil) and (not E.IsDocumentElement) then L.Add(E);
        end;
        // Save objects gathered in list L
        Writer.WriteInteger('#' + C.Name, L.Count);
        for J := 0 to L.Count - 1 do
          Writer.WriteObject(C.Name + '[' + IntToStr(J) + ']', L.Items[J]);
      end
      else begin
        Writer.WriteInteger('#' + C.Name, Cnt);
        for J := 0 to Cnt - 1 do
          Writer.WriteReference(C.Name + '[' + IntToStr(J) + ']', MOF_GetCollectionItem(C.Name, J));
      end;
    end;
  end;
  L.Free;
  // Store extended attributes
  Writer.WriteInteger('ExtendedAttributeCount', GetExtendedAttributeCount);
  for I := 0 to GetExtendedAttributeCount - 1 do
  begin
    EA := GetExtendedAttributeAt(I);
    Writer.WriteString('ExtendedAttributeKey[' + IntToStr(I) + ']', EA.Key);
    Writer.WriteString('ExtendedAttributeValue[' + IntToStr(I) + ']', EA.Value);
  end;
  AfterStore(Writer);
end;

procedure PElement.Load(Reader: PObjectReader);
var
  I, J, Cnt: Integer;
  A: PMetaAttribute;
  R: PMetaReference;
  C: PMetaCollection;
  E: PElement;
  IntegerVal: Integer;
  BooleanVal: Boolean;
  RealVal: Real;
  StringVal: string;
  UserVal: string;
begin
  inherited;
  BeforeLoad(Reader);
  // Load attributes
  for I := 0 to MetaClass.MetaAttributeCount - 1 do begin
    A := MetaClass.MetaAttributes[I];
    if not A.IsDerived then begin
      if A.TypeRef.Name = 'Integer' then begin
        if A.DefaultValue = '' then
          IntegerVal := Reader.ReadInteger(A.Name)
        else
          IntegerVal := Reader.ReadInteger(A.Name, StringToInteger(A.DefaultValue));
        MOF_SetAttribute(A.Name, IntegerToString(IntegerVal));
      end
      else if A.TypeRef.Name = 'Boolean' then begin
        if A.DefaultValue = '' then
          BooleanVal := Reader.ReadBoolean(A.Name)
        else
          BooleanVal := Reader.ReadBoolean(A.Name, StringToBoolean(A.DefaultValue));
        MOF_SetAttribute(A.Name, BooleanToString(BooleanVal));
      end
      else if A.TypeRef.Name = 'Real' then begin
        if A.DefaultValue = '' then
          RealVal := Reader.ReadReal(A.Name)
        else
          RealVal := Reader.ReadReal(A.Name, StringToReal(A.DefaultValue));
        MOF_SetAttribute(A.Name, RealToString(RealVal));
      end
      else if A.TypeRef.Name = 'String' then begin
        StringVal := Reader.ReadString(A.Name, A.DefaultValue);
        MOF_SetAttribute(A.Name, StringVal);
      end
      else begin
        UserVal := Reader.ReadUserDefinedType(A.TypeRef.Name, A.Name, A.DefaultValue);
        MOF_SetAttribute(A.Name, UserVal);
      end;
    end;
  end;
  // Load references
  for I := 0 to MetaClass.MetaReferenceCount - 1 do begin
    R := MetaClass.MetaReferences[I];
    if not R.IsDerived then begin
      if R.Aggregate = makComposite then
        MOF_SetReference(R.Name, Reader.ReadObject(R.Name) as PElement)
      else
        MOF_SetReference(R.Name, Reader.ReadReference(R.Name) as PElement);
    end;
  end;
  // Load collections
  for I := 0 to MetaClass.MetaCollectionCount - 1 do begin
    C := MetaClass.MetaCollections[I];
    if not C.IsDerived then begin
      MOF_ClearCollection(C.Name);
      Cnt := Reader.ReadInteger('#' + C.Name);
      if C.Aggregate = makComposite then
        for J := 0 to Cnt - 1 do begin
          E := Reader.ReadObject(C.Name + '[' + IntToStr(J) + ']') as PElement;
          MOF_AddCollectionItem(C.Name, E);
        end
      else
        for J := 0 to Cnt - 1 do begin
          E := Reader.ReadReference(C.Name + '[' + IntToStr(J) + ']') as PElement;
          MOF_AddCollectionItem(C.Name, E);
        end;
    end;
  end;
  // Load extended attributes
  Cnt := Reader.ReadInteger('ExtendedAttributeCount');
  ClearExtendedAttributes;
  for I := 0 to Cnt - 1 do
  begin
    AddExtendedAttribute(Reader.ReadString('ExtendedAttributeKey[' + IntToStr(I) + ']'),
      Reader.ReadString('ExtendedAttributeValue[' + IntToStr(I) + ']'));
  end;
  AfterLoad(Reader);
end;

procedure PElement.Isolate;
var
  I: Integer;
  R: PMetaReference;
  C: PMetaCollection;
begin
  for I := 0 to MetaClass.MetaReferenceCount - 1 do begin
    R := MetaClass.MetaReferences[I];
    if not R.IsDerived then MOF_SetReference(R.Name, nil);
  end;
  for I := 0 to MetaClass.MetaCollectionCount - 1 do begin
    C := MetaClass.MetaCollections[I];
    if not C.IsDerived then MOF_ClearCollection(C.Name);
  end;
  Document := nil;
  MetaClass := nil;
end;

procedure PElement.Accept(Visitor: PVisitor);
begin
  Visitor.Visit(Self);
end;

function PElement.CreateMemento: PMemento;
begin
  Result := PMemento.Create(Self);
end;

procedure PElement.SetMemento(Memento: PMemento);
begin
  Memento.AssignTo(Self);
end;

function PElement.IsDocumentElement: Boolean;
begin
  Result := (FDocument <> nil);
end;

function PElement.GetContainingDocument: PDocument;
begin
  Result := FDocument;
end;

procedure PElement.ClearExtendedAttributes;
var
  I: Integer;
  EA: PExtendedAttribute;
begin
  for I := FExtendedAttributeList.Count - 1 downto 0 do
  begin
    EA := FExtendedAttributeList.Items[I];
    EA.Free;
  end;
  FExtendedAttributeList.Clear;
end;

function PElement.GetExtendedAttributeAt(Index: Integer): PExtendedAttribute;
begin
  Result := FExtendedAttributeList.Items[Index];
end;

function PElement.GetExtendedAttributeCount: Integer;
begin
  Result := FExtendedAttributeList.Count;
end;

procedure PElement.AddExtendedAttribute(Key, Value: string);
var
  EA: PExtendedAttribute;
begin
  EA := PExtendedAttribute.Create(Key, Value);
  FExtendedAttributeList.Add(EA);
end;

function PElement.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'Tag' then
    Result := Tag
  else
    raise EMetaAttributeNotExist.Create('There is no such Attribute (' + Name + ')');
end;

procedure PElement.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'Tag' then
    Tag := Value
  else
    raise EMetaAttributeNotExist.Create('There is no such Attribute (' + Name + ')');
end;

function PElement.MOF_GetReference(Name: string): PElement;
begin
  raise EMetaReferenceNotExist.Create('There is no such Reference (' + Name + ')');
end;

procedure PElement.MOF_SetReference(Name: string; Value: PElement);
begin
  raise EMetaReferenceNotExist.Create('There is no such Reference (' + Name + ')');
end;

procedure PElement.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

procedure PElement.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

procedure PElement.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

procedure PElement.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

procedure PElement.MOF_ClearCollection(Name: string);
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

function PElement.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

function PElement.MOF_GetCollectionItem(Name: string; Index: Integer): PElement;
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

function PElement.MOF_GetCollectionCount(Name: string): Integer;
begin
  raise EMetaCollectionNotExist.Create('There is no such Collection (' + Name + ')');
end;

// PElement
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PMemento

constructor PMemento.Create(Element: PElement);
begin
  FMetaClass := nil;
  FDocument := nil;
  Attributes := TList.Create;
  References := TList.Create;
  Collections := TList.Create;
  AttributeValues := TStringList.Create;
  ReferenceValues := TList.Create;
  ReferenceIndexes := TStringList.Create;
  CollectionValues := TList.Create;
  ExtendedAttributeKeys := TStringList.Create;
  ExtendedAttributeValues := TStringList.Create;
  AssignFrom(Element);
end;

destructor PMemento.Destroy;
var
  I: Integer;
  L: TList;
begin
  Attributes.Free;
  References.Free;
  Collections.Free;
  AttributeValues.Free;
  ReferenceValues.Free;
  ReferenceIndexes.Free;
  for I := CollectionValues.Count - 1 downto 0 do
  begin
    L := CollectionValues.Items[I];
    L.Free;
  end;
  CollectionValues.Free;
  ExtendedAttributeKeys.Free;
  ExtendedAttributeValues.Free;
  inherited;
end;

procedure PMemento.AssignFrom(Element: PElement);
var
  I, J: Integer;
  A: PMetaAttribute;
  R: PMetaReference;
  C: PMetaCollection;
  OtherSide: PMetaAssociationEnd;
  V: PElement;
  EA: PExtendedAttribute;
  L: TList;
begin
  FMetaClass := Element.MetaClass;
  FDocument := Element.Document;
  // Assign attributes
  for I := 0 to Element.MetaClass.MetaAttributeCount - 1 do
  begin
    A := Element.MetaClass.MetaAttributes[I];
    if not A.IsDerived then
    begin
      Attributes.Add(A);
      AttributeValues.Add(Element.MOF_GetAttribute(A.Name));
    end;
  end;
  // Assign references
  for I := 0 to Element.MetaClass.MetaReferenceCount - 1 do
  begin
    R := Element.MetaClass.MetaReferences[I];
    OtherSide := R.GetOtherSideEnd;
    if not R.IsDerived then
    begin
      V := Element.MOF_GetReference(R.Name);
      References.Add(R);
      ReferenceValues.Add(V);
      if (OtherSide = nil) or OtherSide.IsDerived or (OtherSide.Kind = maeReference) or (V = nil) then
        ReferenceIndexes.Add(IntToStr(-1))
      else
        ReferenceIndexes.Add(IntToStr(V.MOF_IndexOfCollectionItem(R.OtherSide, Element)));
    end;
  end;
  // Assign collections
  for I := 0 to Element.MetaClass.MetaCollectionCount - 1 do
  begin
    C := Element.MetaClass.MetaCollections[I];
    if not C.IsDerived then
    begin
      Collections.Add(C);
      L := TList.Create;
      for J := 0 to Element.MOF_GetCollectionCount(C.Name) - 1 do
      begin
        L.Add(Element.MOF_GetCollectionItem(C.Name, J));
      end;
      CollectionValues.Add(L);
    end;
  end;
  // Assign extended attributes
  for I := 0 to Element.GetExtendedAttributeCount - 1 do
  begin
    EA := Element.GetExtendedAttributeAt(I);
    ExtendedAttributeKeys.Add(EA.Key);
    ExtendedAttributeValues.Add(EA.Value);
  end;
end;

procedure PMemento.AssignTo(Element: PElement);
var
  I, J: Integer;
  A: PMetaAttribute;
  R: PMetaReference;
  C: PMetaCollection;
  OtherSide: PMetaAssociationEnd;
  V: PElement;
  L: TList;
begin
  Element.MetaClass := FMetaClass;
  Element.Document := FDocument;
  // Assign attributes
  for I := 0 to Attributes.Count - 1 do
  begin
    A := Attributes.Items[I];
    Element.MOF_SetAttribute(A.Name, AttributeValues.Strings[I]);
  end;
  // Assign references
  for I := 0 to References.Count - 1 do
  begin
    R := References.Items[I];
    OtherSide := R.GetOtherSideEnd;
    V := ReferenceValues.Items[I];
    if (OtherSide = nil) or OtherSide.IsDerived or (OtherSide.Kind = maeReference) or (V = nil) then
      Element.MOF_SetReference(R.Name, ReferenceValues.Items[I])
    else
    begin
      if V.MOF_GetCollectionCount(OtherSide.Name) < StrToInt(ReferenceIndexes[I]) then
        V.MOF_AddCollectionItem(OtherSide.Name, Element)
      else
        V.MOF_InsertCollectionItem(OtherSide.Name, StrToInt(ReferenceIndexes[I]), Element);
    end;
  end;
  // Assign collections
  for I := 0 to Collections.Count - 1 do
  begin
    C := Collections.Items[I];
    L := CollectionValues.Items[I];
    Element.MOF_ClearCollection(C.Name);
    for J := 0 to L.Count - 1 do
    begin
      Element.MOF_AddCollectionItem(C.Name, L.Items[J]);
    end;
  end;
  // Assign extended attributes
  for I := 0 to ExtendedAttributeKeys.Count - 1 do
  begin
    Element.ClearExtendedAttributes;
    Element.ExtendedAttribute[ExtendedAttributeKeys.Strings[I]].Value := ExtendedAttributeValues.Strings[I];
  end;
end;

// PMemento
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PReferenceCollectionVisitor

constructor PReferenceCollectionVisitor.Create;
begin
  FReferences := POrderedSet.Create;
end;

destructor PReferenceCollectionVisitor.Destroy;
begin
  FReferences.Free;
  FReferences := nil;
  inherited;
end;

function PReferenceCollectionVisitor.GetReference(Index: Integer): PObject;
begin
  Result := FReferences.Items[Index];
end;

function PReferenceCollectionVisitor.GetReferenceCount: Integer;
begin
  Result := FReferences.Count;
end;

procedure PReferenceCollectionVisitor.Clear;
begin
  FReferences.Clear;
end;

procedure PReferenceCollectionVisitor.Visit(Element: PElement);
begin
  FReferences.Add(Element);
end;

// PReferenceCollectionVisitor
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PModel

constructor PModel.Create;
begin
  inherited Create;
  FViews := POrderedSet.Create;
  FOwnedDiagrams := POrderedSet.Create;
  FVirtualOwnedModels := POrderedSet.Create;
  FVirtualNamespace := nil;
  FAttachments := TStringList.Create;
end;

destructor PModel.Destroy;
begin
  FViews.Free;
  FViews := nil;
  FOwnedDiagrams.Free;
  FOwnedDiagrams := nil;
  FVirtualOwnedModels.Free;
  FVirtualOwnedModels := nil;
  FVirtualNamespace := nil;
  FAttachments.Free;
  FAttachments := nil;
  inherited;
end;

procedure PModel.Accept(Visitor: PVisitor);
var
  I: Integer;
begin
  inherited;
  for I := 0 to VirtualOwnedModelCount - 1 do
    VirtualOwnedModels[I].Accept(Visitor);
end;

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

procedure PModel.SetDocumentation(Value: string);
begin
  if FDocumentation <> Value then begin
    FDocumentation := Value;
  end;
end;

function PModel.GetPathname: string;
begin
  if FVirtualNamespace = nil then
    Result := FName
  else
    Result := FVirtualNamespace.GetPathname + PATH_DELIMITER + FName;
end;

function PModel.GetRootModel: PModel;
begin
  if FVirtualNamespace = nil then
    Result := Self
  else
    Result := FVirtualNamespace.GetRootModel;
end;

function PModel.GetView(Index: Integer): PView;
begin
  Result := FViews.Items[Index] as PView;
end;

function PModel.GetViewCount: Integer;
begin
  Result := FViews.Count;
end;

function PModel.GetOwnedDiagram(Index: Integer): PDiagram;
begin
  Result := FOwnedDiagrams.Items[Index] as PDiagram;
end;

function PModel.GetOwnedDiagramCount: Integer;
begin
  Result := FOwnedDiagrams.Count;
end;

function PModel.GetVirtualOwnedModel(Index: Integer): PModel;
begin
  Result := FVirtualOwnedModels.Items[Index] as PModel;
end;

function PModel.GetVirtualOwnedModelCount: Integer;
begin
  Result := FVirtualOwnedModels.Count;
end;

procedure PModel.SetVirtualNamespace(Value: PModel);
begin
  if FVirtualNamespace <> Value then begin
    if FVirtualNamespace <> nil then FVirtualNamespace.FVirtualOwnedModels.Remove(Self);
    FVirtualNamespace := Value;
    if Value <> nil then Value.FVirtualOwnedModels.Add(Self);
  end;
end;

procedure PModel.ClearViews;
var
  I: Integer;
begin
  for I := FViews.Count - 1 downto 0 do
    DeleteView(I);
end;

procedure PModel.AddView(AView: PView);
begin
  if (AView <> nil) and (not FViews.Contains(AView)) then begin
    if AView.FModel <> nil then AView.FModel.FViews.Remove(AView);
    FViews.Add(AView);
    AView.FModel := Self;
  end;
end;

procedure PModel.RemoveView(AView: PView);
begin
  if AView <> nil then begin
    FViews.Remove(AView);
    AView.FModel := nil;
  end;
end;

procedure PModel.InsertView(Index: Integer; AView: PView);
begin
  if (AView <> nil) and (not FViews.Contains(AView)) then begin
    if AView.FModel <> nil then AView.FModel.FViews.Remove(AView);
    FViews.Insert(Index, AView);
    AView.FModel := Self;
  end;
end;

procedure PModel.DeleteView(Index: Integer);
begin
  RemoveView(FViews.Items[Index] as PView);
end;

function PModel.IndexOfView(AView: PView): Integer;
begin
  Result := FViews.IndexOf(AView);
end;

procedure PModel.UpdateViews;
var
  I: Integer;
begin
  for I := 0 to FViews.Count - 1 do begin
    (FViews.Items[I] as PView).Update;
  end;
end;

procedure PModel.ClearOwnedDiagrams;
var
  I: Integer;
begin
  for I := FOwnedDiagrams.Count - 1 downto 0 do
    FOwnedDiagrams.Delete(I);
end;

procedure PModel.AddOwnedDiagram(ADiagram: PDiagram);
begin
  if (ADiagram <> nil) and (not FOwnedDiagrams.Contains(ADiagram)) then begin
    if ADiagram.FDiagramOwner <> nil then begin
      ADiagram.FDiagramOwner.FOwnedDiagrams.Remove(ADiagram);
      ADiagram.FDiagramOwner.RemoveVirtualOwnedModel(ADiagram); // Remove from VirtualOwnedModels
    end;
    FOwnedDiagrams.Add(ADiagram);
    ADiagram.FDiagramOwner := Self;
    AddVirtualOwnedModel(ADiagram); // Add to VirtualOwnedModels
  end;
end;

procedure PModel.RemoveOwnedDiagram(ADiagram: PDiagram);
begin
  if ADiagram <> nil then begin
    FOwnedDiagrams.Remove(ADiagram);
    if ADiagram.FDiagramOwner = Self then ADiagram.FDiagramOwner := nil;
    RemoveVirtualOwnedModel(ADiagram); // Remove from VirtualOwnedModels
  end;
end;

procedure PModel.InsertOwnedDiagram(Index: Integer; ADiagram: PDiagram);
begin
  if (ADiagram <> nil) and (not FOwnedDiagrams.Contains(ADiagram)) then begin
    if ADiagram.FDiagramOwner <> nil then begin
      ADiagram.FDiagramOwner.FOwnedDiagrams.Remove(ADiagram);
      ADiagram.FDiagramOwner.RemoveVirtualOwnedModel(ADiagram); // Remove from VirtualOwnedModels
    end;
    FOwnedDiagrams.Insert(Index, ADiagram);
    ADiagram.FDiagramOwner := Self;
    AddVirtualOwnedModel(ADiagram); // Add to VirtualOwnedModels
  end;
end;

procedure PModel.DeleteOwnedDiagram(Index: Integer);
begin
  RemoveOwnedDiagram(FOwnedDiagrams.Items[Index] as PDiagram);
end;

function PModel.IndexOfOwnedDiagram(ADiagram: PDiagram): Integer;
begin
  Result := FOwnedDiagrams.IndexOf(ADiagram);
end;

procedure PModel.AddVirtualOwnedModel(Model: PModel);
begin
  if (Model <> nil) and (not FVirtualOwnedModels.Contains(Model)) then begin
    if Model.FVirtualNamespace <> nil then Model.FVirtualNamespace.FVirtualOwnedModels.Remove(Model);
    FVirtualOwnedModels.Add(Model);
    Model.FVirtualNamespace := Self;
  end;
end;

procedure PModel.RemoveVirtualOwnedModel(Model: PModel);
begin
  if Model <> nil then begin
    if Model.FVirtualNamespace = Self then Model.FVirtualNamespace := nil;
    FVirtualOwnedModels.Remove(Model);
  end;
end;

procedure PModel.InsertVirtualOwnedModel(Index: Integer; Model: PModel);
begin
  if (Model <> nil) and (not FVirtualOwnedModels.Contains(Model))then begin
    if Model.FVirtualNamespace <> nil then Model.FVirtualNamespace.FVirtualOwnedModels.Remove(Model);
    FVirtualOwnedModels.Insert(Index, Model);
    Model.FVirtualNamespace := Self;
  end;
end;

function PModel.IndexOfVirtualOwnedModel(Model: PModel): Integer;
begin
  Result := FVirtualOwnedModels.IndexOf(Model);
end;

function PModel.IsOneOfTheContainers(Model: PModel): Boolean;
begin
  if (VirtualNamespace = nil) or (Model = Self) then
    Result := False
  else if Model = VirtualNamespace then
    Result := True
  else
    Result := VirtualNamespace.IsOneOfTheContainers(Model);
end;

function PModel.GetContainerRelation(Container: PModel): PMetaReference;
var
  I: Integer;
  R: PMetaReference;
  OtherSide: PMetaAssociationEnd;
begin
  Result := nil;
  for I := 0 to MetaClass.MetaReferenceCount - 1 do
  begin
    R := MetaClass.MetaReferences[I];
    OtherSide := R.GetOtherSideEnd;
    if (OtherSide <> nil) and
       (OtherSide.Aggregate = makComposite) and
       Container.MetaClass.IsKindOf(R.TypeRef.Name) and
       (MOF_GetReference(R.Name) = Container) then
    begin
      Result := R;
      Exit;
    end;
  end;
  Result := MetaClass.GetContainerRelation(Container.MetaClass);
end;

function PModel.CanContainKind(Kind: string): Boolean;
var
  MC: PMetaClass;
begin
  MC := MetaModel.FindMetaClass(Kind);
  if MC <> nil then
    Result := MC.GetContainerRelation(MetaClass) <> nil
  else
    Result := False;
end;

function PModel.CanContain(Model: PModel): Boolean;
begin
  if Model <> nil then
  begin
    if Model is PDiagram then
      Result := CanContainDiagram(Model as PDiagram)
    else
      Result := CanContainKind(Model.MetaClass.Name)
        and (Model <> Self)
        and (not IsOneOfTheContainers(Model))
  end
  else
    Result := False;
end;

function PModel.CanContainDiagramKind(Kind: string): Boolean;
begin
  Result := False;
end;

function PModel.CanContainDiagram(Diagram: PDiagram): Boolean;
begin
  Result := CanContainDiagramKind(Diagram.MetaClass.Name);
end;

function PModel.CanRelocateTo(Model: PModel): Boolean;
begin
  Result := Model.CanContain(Self);
end;

function PModel.CanCopy: Boolean;
begin
  Result := True;
end;

function PModel.CanDelete: Boolean;
begin
  Result := True;
end;

function PModel.CanPaste(Kind, CopyContext: string): Boolean;
begin
  Result := CanContainKind(Kind);
end;

function PModel.ContainsName(AName: string): Boolean;
begin
  Result := FindByName(AName) <> nil;
end;

function PModel.GenerateAvailableName(Model: PModel; Postfix: string = '_'): string;
var
  N: string;
  M: PModel;
begin
  N := Model.Name;
  if N <> '' then begin
    M := FindByName(N);
    while (M <> nil) and (M <> Model) do begin
      N := N + Postfix;
      M := FindByName(N);
    end;
  end;
  Result := N;
end;

function PModel.FindByName(AName: string): PModel;
var
  I: Integer;
  M: PModel;
begin
  for I := 0 to FVirtualOwnedModels.Count - 1 do begin
    M := FVirtualOwnedModels.Items[I] as PModel;
    if M.Name = AName then begin
      Result := M; Exit;
    end;
  end;
  Result := nil;
end;

function PModel.FindByRelativePathname(RelPath: string): PModel;
var
  M: PModel;
begin
  if ExtractTailPath(RelPath) = '' then begin
    Result := FindByName(RelPath);
  end
  else begin
    M := FindByName(ExtractHeadName(RelPath));
    if M = nil then
      Result := nil
    else
      Result := M.FindByRelativePathname(ExtractTailPath(RelPath));
  end;
end;

function PModel.GetContainingDocument: PDocument;
begin
  if IsDocumentElement then
    Result := Document
  else if VirtualNamespace <> nil then
    Result := VirtualNamespace.GetContainingDocument
  else
    Result := nil;
end;

procedure PModel.ClearAttachments;
begin
  FAttachments.Clear;
end;

procedure PModel.AddAttachment(Attach: string);
begin
  FAttachments.Add(Attach);
end;

procedure PModel.InsertAttachment(Index: Integer; Attach: string);
begin
  FAttachments.Insert(Index, Attach);
end;

procedure PModel.DeleteAttachment(Index: Integer);
begin
  FAttachments.Delete(Index);
end;

function PModel.GetAttachmentAt(Index: Integer): string;
begin
  Result := FAttachments.Strings[Index];
end;

function PModel.GetAttachmentCount: Integer;
begin
  Result := FAttachments.Count;
end;

function PModel.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'Name' then begin
    Result := Self.Name;
  end
  else if Name = 'Documentation' then begin
    Result := Documentation;
  end
  else if Name = 'Attachments' then begin
    Result := Attachments.Text;
  end
  else if Name = 'Pathname' then begin
    Result := Pathname;
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PModel.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'Name' then begin
    Self.Name := Value;
  end
  else if Name = 'Documentation' then begin
    Documentation := Value;
  end
  else if Name = 'Attachments' then begin
    Attachments.Text := Value;
  end
  else if Name = 'Pathname' then begin
    // Nothing to do.
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

function PModel.MOF_GetReference(Name: string): PElement;
begin
  Result := inherited MOF_GetReference(Name);
end;

procedure PModel.MOF_SetReference(Name: string; Value: PElement);
begin
  inherited MOF_SetReference(Name, Value);
end;

procedure PModel.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'Views' then begin
    AddView(Value as PView);
  end
  else if Name = 'OwnedDiagrams' then begin
    AddOwnedDiagram(Value as PDiagram);
  end
  else begin
    inherited MOF_AddCollectionItem(Name, Value);
  end;
end;

procedure PModel.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'Views' then begin
    RemoveView(Value as PView);
  end
  else if Name = 'OwnedDiagrams' then begin
    RemoveOwnedDiagram(Value as PDiagram);
  end
  else begin
    inherited MOF_RemoveCollectionItem(Name, Value);
  end;
end;

procedure PModel.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  if Name = 'Views' then begin
    InsertView(Index, Value as PView);
  end
  else if Name = 'OwnedDiagrams' then begin
    InsertOwnedDiagram(Index, Value as PDiagram);
  end
  else begin
    inherited MOF_InsertCollectionItem(Name, Index, Value);
  end;
end;

procedure PModel.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  if Name = 'Views' then begin
    DeleteView(Index);
  end
  else if Name = 'OwnedDiagrams' then begin
    DeleteOwnedDiagram(Index);
  end
  else begin
    inherited MOF_DeleteCollectionItem(Name, Index);
  end;
end;

procedure PModel.MOF_ClearCollection(Name: string);
begin
  if Name = 'Views' then begin
    ClearViews;
  end
  else if Name = 'OwnedDiagrams' then begin
    ClearOwnedDiagrams;
  end
  else begin
    inherited MOF_ClearCollection(Name);
  end;
end;

function PModel.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  if Name = 'Views' then begin
    Result := IndexOfView(Value as PView);
  end
  else if Name = 'OwnedDiagrams' then begin
    Result := IndexOfOwnedDiagram(Value as PDiagram);
  end
  else begin
    Result := inherited MOF_IndexOfCollectionItem(Name, Value);
  end;
end;

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

function PModel.MOF_GetCollectionCount(Name: string): Integer;
begin
  if Name = 'Views' then begin
    Result := ViewCount;
  end
  else if Name = 'OwnedDiagrams' then begin
    Result := OwnedDiagramCount;
  end
  else begin
    Result := inherited MOF_GetCollectionCount(Name);
  end;
end;

// PModel
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PView

constructor PView.Create;
begin
  inherited Create;
  FModel := nil;
  FParent := nil;
  FSubViews := POrderedSet.Create;
  FContainerView := nil;
  FContainedViews := POrderedSet.Create;
  FOwnerDiagramView := nil;
  FVisible := True;
  FEnabled := True;
  FSelected := False;
  FSelectable := True;
  FLineColor := clBlack;
  FFillColor := clWhite;
  FFontColor := clBlack;
  FFontFace := 'Tahoma';
  FFontSize := 8;
  FFontStyle := [];
  FContainerChangeable := True;
  FContainerExtending := True;
end;

destructor PView.Destroy;
begin
  FModel := nil;
  FParent := nil;
  FSubViews.Free;
  FSubViews := nil;
  FContainedViews.Free;
  FContainedViews := nil;
  inherited;
end;

procedure PView.Accept(Visitor: PVisitor);
var
  I: Integer;
begin
  inherited;
  for I := 0 to SubViewCount - 1 do
    SubViews[I].Accept(Visitor);
end;

procedure PView.SetSelected(Value: Boolean);
var
  DV: PDiagramView;
begin
  if FSelectable then
    if FSelected <> Value then begin
      DV := GetDiagramView;
      if DV <> nil then begin
        if Value then DV.FSelectedViews.Add(Self)
        else DV.FSelectedViews.Remove(Self);
      end;
      FSelected := Value;
    end;
end;

procedure PView.SetVisible(Value: Boolean);
begin
  if Value <> FVisible then begin
    FVisible := Value;
  end;
end;

procedure PView.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then begin
    FEnabled := Value;
  end;
end;

procedure PView.SetSelectable(Value: Boolean);
begin
  if Value <> FSelectable then begin
    FSelectable := Value;
  end;
end;

function PView.GetLineColor: TColor;
begin
  if FParentLineColor and (FParent <> nil) then
    FLineColor := FParent.GetLineColor;
  Result := FLineColor;
end;

procedure PView.SetLineColor(Value: TColor);
begin
  if Value <> FLineColor then begin
    FLineColor := Value;
  end;
end;

function PView.GetFillColor: TColor;
begin
  if FParentFillColor and (FParent <> nil) then
    FFillColor := FParent.GetFillColor;
  Result := FFillColor;
end;

procedure PView.SetFillColor(Value: TColor);
begin
  if Value <> FFillColor then begin
    FFillColor := Value;
  end;
end;

function PView.GetFontColor: TColor;
begin
  if FParentFontColor and (FParent <> nil) then
    FFontColor := FParent.GetFontColor;
  Result := FFontColor;
end;

procedure PView.SetFontColor(Value: TColor);
begin
  if FFontColor <> Value then begin
    FFontColor := Value;
  end;
end;

function PView.GetFontFace: string;
begin
  if ParentFontFace and (FParent <> nil) then
    FFontFace := FParent.GetFontFace;
  Result := FFontFace;
end;

procedure PView.SetFontFace(Value: string);
begin
  if FFontFace <> Value then begin
    FFontFace := Value;
  end;
end;

function PView.GetFontSize: Integer;
begin
  if ParentFontSize and (FParent <> nil) then
    FFontSize := FParent.GetFontSize;
  Result := FFontSize;
end;

procedure PView.SetFontSize(Value: Integer);
begin
  if FFontSize <> Value then begin
    FFontSize := Value;
  end;
end;

function PView.GetFontStyle: TFontStyles;
begin
  if ParentFontStyle and (FParent <> nil) then
    FFontStyle := FParent.GetFontStyle;
  Result := FFontStyle;
end;

procedure PView.SetFontStyle(Value: TFontStyles);
begin
  if FFontStyle <> Value then begin
    FFontStyle := Value;
  end;
end;

procedure PView.SetParentLineColor(Value: Boolean);
begin
  if FParentLineColor <> Value then begin
    FParentLineColor := Value;
  end;
end;

procedure PView.SetParentFillColor(Value: Boolean);
begin
  if FParentFillColor <> Value then begin
    FParentFillColor := Value;
  end;
end;

procedure PView.SetParentFontFace(Value: Boolean);
begin
  if FParentFontFace <> Value then begin
    FParentFontFace := Value;
  end;
end;

procedure PView.SetParentFontSize(Value: Boolean);
begin
  if FParentFontSize <> Value then begin
    FParentFontSize := Value;
  end;
end;

procedure PView.SetParentFontColor(Value: Boolean);
begin
  if FParentFontColor <> Value then begin
    FParentFontColor := Value;
  end;
end;

procedure PView.SetParentFontStyle(Value: Boolean);
begin
  if FParentFontStyle <> Value then begin
    FParentFontStyle := Value;
  end;
end;

procedure PView.SetModel(Value: PModel);
begin
  if FModel <> Value then begin
    if FModel <> nil then FModel.RemoveView(Self);
    FModel := Value;
    if FModel <> nil then FModel.AddView(Self);
  end;
end;

procedure PView.SetParent(Value: PView);
begin
  if FParent <> Value then begin
    if FParent <> nil then begin
      FParent.RemoveSubView(Self);
      if FParent is PDiagramView then SetSelected(False);
    end;
    FParent := Value;
    if Value <> nil then FParent.AddSubView(Self);
  end;
end;

function PView.GetSubView(Index: Integer): PView;
begin
  if Index < FSubViews.Count then Result := FSubViews.Items[Index] as PView
  else Result := nil;
end;

function PView.GetSubViewCount: Integer;
begin
  Result := FSubViews.Count;
end;

function PView.GetContainedView(Index: Integer): PView;
begin
  Result := FContainedViews.Items[Index] as PView;
end;

function PView.GetContainedViewCount: Integer;
begin
  Result := FContainedViews.Count;
end;

procedure PView.SetContainerView(Value: PView);
begin
  if FContainerView <> Value then begin
    if FContainerView <> nil then
      FContainerView.RemoveContainedView(Self);
    if FOwnerDiagramView <> nil then
      FOwnerDiagramView.RemoveOwnedView(Self);
    FContainerView := Value;
    if FContainerView <> nil then
      FContainerView.AddContainedView(Self);
  end;
end;

procedure PView.SetOwnerDiagramView(Value: PDiagramView);
begin
  if FOwnerDiagramView <> Value then begin
    if FOwnerDiagramView <> nil then
      FOwnerDiagramView.RemoveOwnedView(Self);
    if FContainerView <> nil then
      FContainerView.RemoveContainedView(Self);
    FOwnerDiagramView := Value;
    if FOwnerDiagramView <> nil then
      FOwnerDiagramView.AddOwnedView(Self);
  end;
end;

procedure PView.SetContainerChangeable(Value: Boolean);
begin
  if FContainerChangeable <> Value then begin
    FContainerChangeable := Value;
  end;
end;

procedure PView.SetContainerExtending(Value: Boolean);
begin
  if FContainerExtending <> Value then begin
    FContainerExtending := Value;
  end;
end;

procedure PView.AssignStyleToCanvas(Canvas: PCanvas);
begin
  Canvas.Pen.Color := LineColor;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Pen.Width := 1;
  Canvas.Brush.Color := FillColor;
  Canvas.Brush.Style := bsSolid;
end;

procedure PView.AssignFontToCanvas(Canvas: PCanvas);
begin
  Canvas.Font.Name := FontFace;
  Canvas.Font.Color := FontColor;
  Canvas.Font.Size := FontSize;
  Canvas.Font.Style := FontStyle;
end;

procedure PView.DrawObject(Canvas: PCanvas);
begin
  // No Implementation.
end;

procedure PView.DrawSelection(Canvas: PCanvas);
begin
  // No Implementation.
end;

procedure PView.DrawNoModeledMark(Canvas: PCanvas);
begin
  // No Implementation.
end;

procedure PView.MovePosition(Canvas: PCanvas; DX, DY: Integer);
begin
  // No Implementation.
end;

procedure PView.ArrangeObject(Canvas: PCanvas);
begin
  // No Implementation.
end;

procedure PView.DelimitContainingBoundary(Canvas: PCanvas);
begin
  // No Implementation.
end;

procedure PView.Setup;
begin
  // No Implementation.
end;

procedure PView.Initialize(Canvas: PCanvas; X1, Y1, X2, Y2: Integer);
begin
  // No Implementaion.
end;

procedure PView.Draw(Canvas: PCanvas);
var
  I: Integer;
begin
  if FVisible then begin
    Arrange(Canvas);
    DrawObject(Canvas);
    for I := 0 to FSubViews.Count - 1 do
      (FSubViews.Items[I] as PView).Draw(Canvas);
    if Model = nil then
      DrawNoModeledMark(Canvas);
  end;
end;

procedure PView.Move(Canvas: PCanvas; DX, DY: Integer);
var
  I: Integer;
begin
  if (DX <> 0) or (DY <> 0) then begin
    MovePosition(Canvas, DX, DY);
    for I := 0 to FSubViews.Count - 1 do
      (FSubViews.Items[I] as PView).Move(Canvas, DX, DY);
  end;
end;

procedure PView.Arrange(Canvas: PCanvas);
var
  I: Integer;
  AView: PView;
begin
  for I := 0 to FSubViews.Count - 1 do begin
    AView := FSubViews.Items[I] as PView;
    AView.Arrange(Canvas);
  end;
  DelimitContainingBoundary(Canvas);
  ArrangeObject(Canvas);
end;

procedure PView.Update;
var
  I: Integer;
  AView: PView;
begin
  if Model = nil then Exit;
  for I := 0 to FContainedViews.Count - 1 do begin
    AView := FContainedViews.Items[I] as PView;
    AView.Update;
  end;
end;

procedure PView.BringToFront;
var
  Owner: PDiagramView;
begin
  if FOwnerDiagramView <> nil then begin
    Owner := FOwnerDiagramView;
    Owner.RemoveOwnedView(Self);
    Owner.AddOwnedView(Self);
  end;
end;

procedure PView.SendToBack;
var
  Owner: PDiagramView;
begin
  if FOwnerDiagramView <> nil then begin
    Owner := FOwnerDiagramView;
    Owner.RemoveOwnedView(Self);
    Owner.InsertOwnedView(0, Self);
  end;
end;

function PView.GetContainingDocument: PDocument;
var
  DV: PDiagramView;
begin
  if IsDocumentElement then begin
    Result := Document;
  end
  else begin
    DV := GetDiagramView;
    if (DV <> nil) then
      Result := DV.GetContainingDocument
    else
      Result := nil;
  end;
end;

function PView.GetViewAt(Canvas: PCanvas; X, Y: Integer): PView;
var
  I: Integer;
  V, SubView: PView;
begin
  Result := nil;
  for I := FSubViews.Count - 1 downto 0 do begin
    V := FSubViews.Items[I] as PView;
    if V.Visible and V.Selectable then begin
      SubView := V.GetViewAt(Canvas, X, Y);
      if SubView <> nil then begin
        Result := SubView;
        Exit;
      end;
    end;
  end;
  if ContainsPoint(Canvas, Point(X, Y)) then Result := Self;
end;

function PView.GetDiagramView: PDiagramView;
begin
  if FOwnerDiagramView <> nil then begin
    Result:= FOwnerDiagramView;
  end
  else begin
    if FParent <> nil then
      Result := FParent.GetDiagramView
    else
      Result := nil;
  end;
end;

procedure PView.ClearSubViews;
var
  I: Integer;
begin
  for I := FSubViews.Count - 1 downto 0 do
    RemoveSubView(FSubViews.Items[I] as PView);
  FSubViews.Clear;
end;

procedure PView.AddSubView(V: PView);
begin
  if (V <> nil) and (not FSubViews.Contains(V)) then begin
    if V.FParent <> nil then V.FParent.FSubViews.Remove(V);
    FSubViews.Add(V);
    V.FParent := Self;
  end;
end;

procedure PView.RemoveSubView(V: PView);
begin
  if V <> nil then begin
    if V <> nil then V.FParent := nil;
    FSubViews.Remove(V);
  end;
end;

procedure PView.InsertSubView(Index: Integer; V: PView);
begin
  if (V <> nil) and (not FSubViews.Contains(V)) then begin
    if V.FParent <> nil then V.FParent.FSubViews.Remove(V);
    FSubViews.Insert(Index, V);
    V.FParent := Self;
  end;
end;

procedure PView.DeleteSubView(Index: Integer);
var
  V: PView;
begin
  V := FSubViews.Items[Index] as PView;
  FSubViews.Delete(Index);
  if V <> nil then V.FParent := nil;
end;

function PView.IndexOfSubView(V: PView): Integer;
begin
  Result := FSubViews.IndexOf(V);
end;

function PView.IncludesSubView(V: PView): Boolean;
var
  TV: PView;
begin
  TV := V;
  Result := False;
  while not(TV is PDiagramView) and (TV <> nil) do begin
    if TV = Self then begin
      Result := True;
      Exit;
    end;
    TV := TV.Parent;
  end;
end;

procedure PView.ClearContainedViews;
var
  I: Integer;
begin
  for I := FContainedViews.Count - 1 downto 0 do
    RemoveContainedView(FContainedViews.Items[I] as PView);
  FContainedViews.Clear;
end;

procedure PView.AddContainedView(V: PView);
begin
  if (V <> nil) and (not FContainedViews.Contains(V)) then begin
    if V.FOwnerDiagramView <> nil then begin
      V.FOwnerDiagramView.FOwnedViews.Remove(V);
      V.FOwnerDiagramView := nil;
    end;
    if V.FContainerView <> nil then begin
      V.FContainerView.FContainedViews.Remove(V);
      V.FContainerView.RemoveSubView(V);
    end;
    FContainedViews.Add(V);
    V.FContainerView := Self;
    AddSubView(V);
  end;
end;

procedure PView.RemoveContainedView(V: PView);
begin
  if V <> nil then begin
    if V <> nil then V.FContainerView := nil;
    FContainedViews.Remove(V);
    RemoveSubView(V);
  end;
end;

procedure PView.InsertContainedView(Index: Integer; V: PView);
begin
  if (V <> nil) and (not FContainedViews.Contains(V)) then begin
    if V.FOwnerDiagramView <> nil then begin
      V.FOwnerDiagramView.FOwnedViews.Remove(V);
      V.FOwnerDiagramView := nil;
    end;
    if V.FContainerView <> nil then begin
      V.FContainerView.FContainedViews.Remove(V);
      V.FContainerView.RemoveSubView(V);
    end;      
    FContainedViews.Insert(Index, V);
    V.FContainerView := Self;
    AddSubView(V);
  end;
end;

procedure PView.DeleteContainedView(Index: Integer);
var
  V: PView;
begin
  V := FContainedViews.Items[Index] as PView;
  FContainedViews.Delete(Index);
  if V <> nil then begin
    V.FContainerView := nil;
    RemoveSubView(V);
  end;
end;

function PView.IndexOfContainedView(V: PView): Integer;
begin
  Result := FContainedViews.IndexOf(V);
end;

function PView.IsOneOfTheContainerViews(V: PView): Boolean;
begin
  if (ContainerView = nil) or (V = Self) then
    Result := False
  else if ContainerView = V then
    Result := True
  else
    Result := ContainerView.IsOneOfTheContainerViews(V);
end;

function PView.CanContainViewKind(Kind: string): Boolean;
begin
  Result := False;
end;

function PView.CanContainView(V: PView): Boolean;
begin
  Result := (V <> nil)
    and (V <> Self)
    and (not IsOneOfTheContainerViews(V))
    and CanContainViewKind(V.MetaClass.Name);
end;

procedure PView.DrawContainingBox(Canvas: PCanvas);
var
  ARect: TRect;
begin
  ARect := GetBoundingBox(Canvas);
  DrawRangeBox(Canvas, ARect.Left - 1, ARect.Top - 1, ARect.Right + 0, ARect.Bottom + 0);
end;

procedure PView.EraseContainingBox(Canvas: PCanvas);
var
  ARect: TRect;
begin
  ARect := GetBoundingBox(Canvas);
  DrawRangeBox(Canvas, ARect.Left - 1, ARect.Top - 1, ARect.Right + 0, ARect.Bottom + 0);
end;

function PView.GetBoundingBox(Canvas: PCanvas): TRect;
var
  R: TRect;
begin
  R.Left := High(Integer);
  R.Top := High(Integer);
  R.Right := -High(Integer);
  R.Bottom := -High(Integer);
  Result := R;
end;

function PView.ContainsPoint(Canvas: PCanvas; P: TPoint): Boolean;
var
  R, ZR: TRect;
  ZP: TPoint;
begin
  R := GetBoundingBox(Canvas);
  if FSelected then begin
    ZR := R;
    ZP := P;
    CoordTransform(Canvas.ZoomFactor, NOGRID, ZR);
    ZR := Rect(ZR.Left - DEFAULT_HIGHLIGHTER_SIZE, ZR.Top - DEFAULT_HIGHLIGHTER_SIZE,
      ZR.Right + DEFAULT_HIGHLIGHTER_SIZE, ZR.Bottom + DEFAULT_HIGHLIGHTER_SIZE);
    CoordTransform(Canvas.ZoomFactor, NOGRID, ZP);
    Result := PtInRect(ZR, ZP);
  end
  else
    Result := PtInRect(R, P);
end;

function PView.ContainsPoint(Canvas: PCanvas; X, Y: Integer): Boolean;
begin
  Result := ContainsPoint(Canvas, Point(X, Y));
end;

function PView.OverlapRect(Canvas: PCanvas; R: TRect): Boolean;
var
  Rgn: HRgn;
  RT: TRect;
begin
  RT := GetBoundingBox(Canvas);
  if FSelected then RT := Rect(RT.Left - 5, RT.Top - 5, RT.Right + 5, RT.Bottom + 5);
  Rgn := CreateRectRgn(RT.Left, RT.Top, RT.Right, RT.Bottom);
  Result := RectInRegion(Rgn, R);
  DeleteObject(Rgn);
end;

function PView.OverlapRect(Canvas: PCanvas; X1, Y1, X2, Y2: Integer): Boolean;
begin
  Result := OverlapRect(Canvas, Rect(X1, Y1, X2, Y2));
end;

function PView.MOF_GetAttribute(Name: string): string;
var
  Sty: Integer;
begin
  if Name = 'LineColor' then begin
    Result := ColorToString(LineColor);
  end
  else if Name = 'FillColor' then begin
    Result := ColorToString(FillColor);
  end
  else if Name = 'FontFace' then begin
    Result := FontFace;
  end
  else if Name = 'FontColor' then begin
    Result := ColorToString(FontColor);
  end
  else if Name = 'FontSize' then begin
    Result := IntegerToString(FontSize);
  end
  else if Name = 'FontStyle' then begin
    Sty := 0;
    if fsBold in FFontStyle then Sty := Sty + 1;
    if fsItalic in FFontStyle then Sty := Sty + 2;
    if fsUnderline in FFontStyle then Sty := Sty + 4;
    if fsStrikeOut in FFontStyle then Sty := Sty + 8;
    Result := IntegerToString(Sty);
  end
  else if Name = 'Visible' then begin
    Result := BooleanToString(Visible);
  end
  else if Name = 'Enabled' then begin
    Result := BooleanToString(Enabled);
  end
  else if Name = 'Selected' then begin
    Result := BooleanToString(Selected);
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PView.MOF_SetAttribute(Name, Value: string);
var
  Sty: Integer;
begin
  if Name = 'LineColor' then begin
    LineColor := StringToColor(Value);
  end
  else if Name = 'FillColor' then begin
    FillColor := StringToColor(Value);
  end
  else if Name = 'FontFace' then begin
    FontFace:= Value;
  end
  else if Name = 'FontColor' then begin
    FontColor := StringToColor(Value);
  end
  else if Name = 'FontSize' then begin
    FontSize := StringToInteger(Value);
  end
  else if Name = 'FontStyle' then begin
    Sty := StringToInteger(Value);
    if (Sty and 1) <> 0 then FFontStyle := FFontStyle + [fsBold];
    if (Sty and 2) <> 0 then FFontStyle := FFontStyle + [fsItalic];
    if (Sty and 4) <> 0 then FFontStyle := FFontStyle + [fsUnderLine];
    if (Sty and 8) <> 0 then FFontStyle := FFontStyle + [fsStrikeOut];
  end
  else if Name = 'Visible' then begin
    Visible := StringToBoolean(Value);
  end
  else if Name = 'Enabled' then begin
    Enabled := StringToBoolean(Value);
  end
  else if Name = 'Selected' then begin
    Selected := StringToBoolean(Value);
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

function PView.MOF_GetReference(Name: string): PElement;
begin
  if Name = 'Model' then begin
    Result := Model;
  end
  else if Name = 'ContainerView' then begin
    Result := ContainerView;
  end
  else if Name = 'OwnerDiagramView' then begin
    Result := OwnerDiagramView;
  end
  else begin
    Result := inherited MOF_GetReference(Name);
  end;
end;

procedure PView.MOF_SetReference(Name: string; Value: PElement);
begin
  if Name = 'Model' then begin
    Model := Value as PModel;
  end
  else if Name = 'ContainerView' then begin
    ContainerView := Value as PView;
  end
  else if Name = 'OwnerDiagramView' then begin
    OwnerDiagramView := Value as PDiagramView;
  end
  else begin
    inherited MOF_SetReference(Name, Value);
  end;
end;

procedure PView.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'ContainedViews' then begin
    AddContainedView(Value as PView);
  end
  else begin
    inherited MOF_AddCollectionItem(Name, Value);
  end;
end;

procedure PView.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'ContainedViews' then begin
    RemoveContainedView(Value as PView);
  end
  else begin
    inherited MOF_RemoveCollectionItem(Name, Value);
  end;
end;

procedure PView.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  if Name = 'ContainedViews' then begin
    InsertContainedView(Index, Value as PView);
  end
  else begin
    inherited MOF_InsertCollectionItem(Name, Index, Value);
  end;
end;

procedure PView.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  if Name = 'ContainedViews' then begin
    DeleteContainedView(Index);
  end
  else begin
    inherited MOF_DeleteCollectionItem(Name, Index);
  end;
end;

procedure PView.MOF_ClearCollection(Name: string);
begin
  if Name = 'ContainedViews' then begin
    ClearContainedViews;
  end
  else begin
    inherited MOF_ClearCollection(Name);
  end;
end;

function PView.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  if Name = 'ContainedViews' then begin
    Result := IndexOfContainedView(Value as PView);
  end
  else begin
    Result := inherited MOF_IndexOfCollectionItem(Name, Value);
  end;
end;

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

function PView.MOF_GetCollectionCount(Name: string): Integer;
begin
  if Name = 'ContainedViews' then begin
    Result := ContainedViewCount;
  end
  else begin
    Result := inherited MOF_GetCollectionCount(Name);
  end;
end;

// PView
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDiagram

constructor PDiagram.Create;
begin
  inherited;
  FDefaultDiagram := False;
  FDiagramView := nil;
  FDiagramOwner := nil;
end;

procedure PDiagram.Accept(Visitor: PVisitor);
begin
  inherited;
  FDiagramView.Accept(Visitor);
end;

function PDiagram.GetContainingDocument: PDocument;
begin
  if IsDocumentElement then begin
    Result := Document;
  end
  else begin
    if DiagramOwner <> nil then
      Result := DiagramOwner.GetContainingDocument
    else
      Result := nil;
  end;
end;

procedure PDiagram.SetDefaultDiagram(Value: Boolean);
begin
  if FDefaultDiagram <> Value then begin
    FDefaultDiagram := Value;
  end;
end;

procedure PDiagram.SetDiagramType(Value: string);
begin
  if FDiagramType <> Value then begin
    FDiagramType := Value;
  end;
end;

procedure PDiagram.SetDiagramView(Value: PDiagramView);
begin
  if FDiagramView <> Value then begin
    if FDiagramView <> nil then FDiagramView.FDiagram := nil;
    FDiagramView := Value;
    if FDiagramView <> nil then FDiagramView.FDiagram := Self;
  end;
end;

procedure PDiagram.SetDiagramOwner(Value: PModel);
begin
  if FDiagramOwner <> Value then begin
    if FDiagramOwner <> nil then begin
      FDiagramOwner.FOwnedDiagrams.Remove(Self);
      FDiagramOwner.RemoveVirtualOwnedModel(Self); // Remove from VirtualOwnedModels
    end;
    FDiagramOwner := Value;
    if Value <> nil then begin
      Value.FOwnedDiagrams.Add(Self);
      Value.AddVirtualOwnedModel(Self); // Add to VirtualOwnedModels
    end;
  end;
end;

function PDiagram.CanContainKind(Kind: string): Boolean;
begin
  Result := False;
end;

function PDiagram.MOF_GetAttribute(Name: string): string;
begin
  if Name = 'DefaultDiagram' then begin
    Result := BooleanToString(DefaultDiagram);
  end
  else if Name = 'DiagramType' then begin
    Result := DiagramType;
  end
  else begin
    Result := inherited MOF_GetAttribute(Name);
  end;
end;

procedure PDiagram.MOF_SetAttribute(Name, Value: string);
begin
  if Name = 'DefaultDiagram' then begin
    DefaultDiagram := StringToBoolean(Value);
  end
  else if Name = 'DiagramType' then begin
    DiagramType := Value;
  end
  else begin
    inherited MOF_SetAttribute(Name, Value);
  end;
end;

function PDiagram.MOF_GetReference(Name: string): PElement;
begin
  if Name = 'DiagramOwner' then begin
    Result := DiagramOwner;
  end
  else if Name = 'DiagramView' then begin
    Result := DiagramView;
  end
  else begin
    Result := inherited MOF_GetReference(Name);
  end;
end;

procedure PDiagram.MOF_SetReference(Name: string; Value: PElement);
begin
  if Name = 'DiagramOwner' then begin
    DiagramOwner := Value as PModel;
  end
  else if Name = 'DiagramView' then begin
    DiagramView := Value as PDiagramView;
  end
  else begin
    inherited MOF_SetReference(Name, Value);
  end;
end;

// PDiagram
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDiagramView

constructor PDiagramView.Create;
begin
  inherited;
  FDiagram := nil;
  FCanvas := nil;
  FOwnedViews := POrderedSet.Create;
  FSelectedViews := POrderedSet.Create;
end;

destructor PDiagramView.Destroy;
begin
  FDiagram := nil;
  FCanvas := nil;
  FOwnedViews.Free;
  FOwnedViews := nil;
  FSelectedViews.Free;
  FSelectedViews := nil;
  inherited;
end;

procedure PDiagramView.Accept(Visitor: PVisitor);
var
  I: Integer;
begin
  inherited;
  for I := 0 to OwnedViewCount - 1 do
    OwnedViews[I].Accept(Visitor);
end;

procedure PDiagramView.SetDiagram(Value: PDiagram);
begin
  if FDiagram <> Value then begin
    if FDiagram <> nil then FDiagram.FDiagramView := nil;
    FDiagram := Value;
    if FDiagram <> nil then FDiagram.FDiagramView := Self;
  end;
end;

function PDiagramView.GetSelectedView(Index: Integer): PView;
begin
  Result := FSelectedViews.Items[Index] as PView;
end;

function PDiagramView.GetSelectedCount: Integer;
begin
  Result := FSelectedViews.Count;
end;

function PDiagramView.GetOwnedView(Index: Integer): PView;
begin
  Result := FOwnedViews.Items[Index] as PView;
end;

function PDiagramView.GetOwnedViewCount: Integer;
begin
  Result := FOwnedViews.Count;
end;

procedure PDiagramView.DrawObject(Canvas: PCanvas);
var
  I: Integer;
  AView: PView;
begin
  for I := 0 to FOwnedViews.Count - 1 do begin
    AView := FOwnedViews.Items[I] as PView;
    AView.Arrange(Canvas);
    // (FOwnedViews.Items[I] as PView).Arrange(Canvas);
  end;
end;

procedure PDiagramView.Draw(Canvas: PCanvas);
var
  I: Integer;
begin
  if FVisible then begin
    Arrange(Canvas);
    DrawObject(Canvas);
    for I := 0 to FOwnedViews.Count - 1 do
      (FOwnedViews.Items[I] as PView).Draw(Canvas);
  end;
end;

procedure PDiagramView.DrawDiagram(Canvas: PCanvas);
var
  I: Integer;
begin
  if FVisible then begin
    Draw(Canvas);
    for I := 0 to FSelectedViews.Count - 1 do
      (FSelectedViews.Items[I] as PView).DrawSelection(Canvas);
  end;
end;

procedure PDiagramView.Update;
var
  I: Integer;
begin
  for I := 0 to OwnedViewCount - 1 do
    OwnedViews[I].Update;
end;

function PDiagramView.GetContainingDocument: PDocument;
begin
  if IsDocumentElement then begin
    Result := Document;
  end
  else begin
    if Diagram <> nil then
      Result := Diagram.GetContainingDocument
    else
      Result := nil;
  end;
end;

function PDiagramView.GetViewAt(Canvas: PCanvas; X, Y: Integer): PView;
var
  I: Integer;
  V, SubView: PView;
begin
  Result := nil;
  for I := FOwnedViews.Count - 1 downto 0 do begin
    V := FOwnedViews.Items[I] as PView;
    if V.Visible and V.Selectable then begin
      SubView := V.GetViewAt(Canvas, X, Y);
      if SubView <> nil then begin
        Result := SubView;
        Exit;
      end;
    end;
  end;
  if ContainsPoint(Canvas, Point(X, Y)) then Result := Self;
end;

function PDiagramView.GetBottomViewAt(Canvas: PCanvas; X, Y: Integer): PView;
var
  I: Integer;
  V: PView;
begin
  Result := nil;
  for I := FOwnedViews.Count - 1 downto 0 do begin
    V := FOwnedViews.Items[I] as PView;
    if V.Visible and V.Selectable and V.ContainsPoint(Canvas, X, Y) then begin
      Result := V;
      Exit;
    end;
  end;
  if ContainsPoint(Canvas, Point(X, Y)) then Result := Self;
end;

function PDiagramView.GetBoundingBox(Canvas: PCanvas): TRect;
var
  V: PView;
  I: Integer;
  R: TRect;
begin
  R := Rect(10000, 10000, -10000, -10000);
  for I := 0 to OwnedViewCount - 1 do begin
    V := OwnedViews[I];
    if V.Visible then
      UnionRect(R, R, V.GetBoundingBox(Canvas));
  end;
  Result := R;
end;

function PDiagramView.GetSelectedBoundingBox(Canvas: PCanvas): TRect;
var
  V: PView;
  I: Integer;
  R: TRect;
begin
  R := Rect(10000, 10000, -10000, -10000);
  for I := 0 to SelectedViewCount - 1 do begin
    V := SelectedViews[I];
    UnionRect(R, R, V.GetBoundingBox(Canvas));
  end;
  Result := R;
end;

function PDiagramView.ContainsPoint(Canvas: PCanvas; P: TPoint): Boolean;
begin
  Result := False;
end;

function PDiagramView.OverlapRect(Canvas: PCanvas; R: TRect): Boolean;
begin
  Result := False;
end;

procedure PDiagramView.SelectAll;

  procedure SelectView(V: PView);
  var
    I: Integer;
  begin
    if V.Visible and V.Enabled and V.Selectable then
      V.Selected := True;
    for I := 0 to V.SubViewCount - 1 do
      SelectView(V.SubViews[I]);
  end;

var
  I: Integer;
begin
  for I := 0 to FOwnedViews.Count - 1 do
    SelectView(FOwnedViews.Items[I] as PView);
end;

procedure PDiagramView.DeselectAll;
var
  I: Integer;
begin
  for I := FSelectedViews.Count - 1 downto 0  do
    (FSelectedViews.Items[I] as PView).Selected := False;
  FSelectedViews.Clear;
end;

procedure PDiagramView.SelectArea(Canvas: PCanvas; X1, Y1, X2, Y2: Integer);

  procedure SelectView(V: PView; X1, Y1, X2, Y2: Integer);
  var
    I: Integer;
  begin
    if V.Visible and V.Enabled and V.Selectable then
      if V.OverlapRect(Canvas, Rect(X1, Y1, X2, Y2)) then
        V.Selected := True;
    for I := 0 to V.SubViewCount - 1 do
      SelectView(V.SubViews[I], X1, Y1, X2, Y2);
  end;

var
  I: Integer;
begin
  NormalizeRect(X1, Y1, X2, Y2);
  for I := 0 to FOwnedViews.Count - 1 do
    SelectView(FOwnedViews.Items[I] as PView, X1, Y1, X2, Y2);
end;

procedure PDiagramView.ClearOwnedViews;
var
  I: Integer;
begin
  for I := FOwnedViews.Count - 1 downto 0 do
    DeleteOwnedView(I);
end;

procedure PDiagramView.AddOwnedView(AView: PView);
begin
  if (AView <> nil) and (not FOwnedViews.Contains(AView)) then begin
    if AView.FContainerView <> nil then begin
      AView.FContainerView.FContainedViews.Remove(AView);
      AView.RemoveSubView(AView);
      AView.FContainerView := nil;
    end;
    if AView.FOwnerDiagramView <> nil then
      AView.FOwnerDiagramView.FOwnedViews.Remove(AView);
    FOwnedViews.Add(AView);
    AView.FOwnerDiagramView := Self;
  end;
end;

procedure PDiagramView.RemoveOwnedView(AView: PView);
begin
  if AView <> nil then begin
    FOwnedViews.Remove(AView);
    AView.FOwnerDiagramView := nil;
  end;
end;

procedure PDiagramView.InsertOwnedView(Index: Integer; AView: PView);
begin
  if (AView <> nil) and (not FOwnedViews.Contains(AView)) then begin
    if AView.FContainerView <> nil then begin
      AView.FContainerView.FContainedViews.Remove(AView);
      AView.RemoveSubView(AView);
      AView.FContainerView := nil;
    end;
    if AView.FOwnerDiagramView <> nil then
      AView.FOwnerDiagramView.FOwnedViews.Remove(AView);
    FOwnedViews.Insert(Index, AView);
    AView.FOwnerDiagramView := Self;
  end;
end;

procedure PDiagramView.DeleteOwnedView(Index: Integer);
begin
  RemoveOwnedView(FOwnedViews.Items[Index] as PView);
end;

function PDiagramView.IndexOfOwnedView(AView: PView): Integer;
begin
  Result := FOwnedViews.IndexOf(AView);
end;

function PDiagramView.CanOwnView(View: PView): Boolean;
begin
  Result := CanOwnViewKind(View.MetaClass.Name);
end;

function PDiagramView.CanOwnViewKind(Kind: string): Boolean;
begin
  Result := False;
end;

function PDiagramView.CanCopyViews: Boolean;
begin
  Result := (SelectedViewCount > 0);
end;

function PDiagramView.CanDeleteViews: Boolean;
begin
  Result := (SelectedViewCount > 0);
end;

function PDiagramView.CanPasteViews(Kind, CopyContext: string): Boolean;
begin
  Result := True;
end;

function PDiagramView.CanAcceptModel(Model: PModel): Boolean;
begin
  Result := False;
end;

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

procedure PDiagramView.MOF_SetReference(Name: string; Value: PElement);
begin
  if Name = 'Diagram' then begin
    Diagram := Value as PDiagram;
  end
  else begin
    inherited MOF_SetReference(Name, Value);
  end;
end;

procedure PDiagramView.MOF_AddCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'SelectedViews' then begin
    // Nothing to do.
  end
  else if Name = 'OwnedViews' then begin
    AddOwnedView(Value as PView);
  end
  else begin
    inherited MOF_AddCollectionItem(Name, Value);
  end;
end;

procedure PDiagramView.MOF_RemoveCollectionItem(Name: string; Value: PElement);
begin
  if Name = 'SelectedViews' then begin
    // Nothing to do.
  end
  else if Name = 'OwnedViews' then begin
    RemoveOwnedView(Value as PView);
  end
  else begin
    inherited MOF_RemoveCollectionItem(Name, Value);
  end;
end;

procedure PDiagramView.MOF_InsertCollectionItem(Name: string; Index: Integer; Value: PElement);
begin
  if Name = 'SelectedViews' then begin
    // Nothing to do.
  end
  else if Name = 'OwnedViews' then begin
    InsertOwnedView(Index, Value as PView);
  end
  else begin
    inherited MOF_InsertCollectionItem(Name, Index, Value);
  end;
end;

procedure PDiagramView.MOF_DeleteCollectionItem(Name: string; Index: Integer);
begin
  if Name = 'SelectedViews' then begin
    // Nothing to do.
  end
  else if Name = 'OwnedViews' then begin
    DeleteOwnedView(Index);
  end
  else begin
    inherited MOF_DeleteCollectionItem(Name, Index);
  end;
end;

procedure PDiagramView.MOF_ClearCollection(Name: string);
begin
  if Name = 'SelectedViews' then begin
    // Nothing to do.
  end
  else if Name = 'OwnedViews' then begin
    ClearOwnedViews;
  end
  else begin
    inherited MOF_ClearCollection(Name);
  end;
end;

function PDiagramView.MOF_IndexOfCollectionItem(Name: string; Value: PElement): Integer;
begin
  if Name = 'SelectedViews' then begin
    Result := -1;
  end
  else if Name = 'OwnedViews' then begin
    Result := IndexOfOwnedView(Value as PView);
  end
  else begin
    Result := inherited MOF_IndexOfCollectionItem(Name, Value);
  end;
end;

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

function PDiagramView.MOF_GetCollectionCount(Name: string): Integer;
begin
  if Name = 'SelectedViews' then begin
    Result := SelectedViewCount;
  end
  else if Name = 'OwnedViews' then begin
    Result := OwnedViewCount;
  end
  else begin
    Result := inherited MOF_GetCollectionCount(Name);
  end;
end;

// PDiagramView
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PReferenceResolveItem

constructor PReferenceResolveItem.Create(AElement: PElement; AName, AGUID, APathname: string; AIsCollection: Boolean);
begin
  Element := AElement;
  Name := AName;
  GUID := AGUID;
  Pathname := APathname;
  IsCollection := AIsCollection;
end;

// PReferenceResolveItem
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PReferenceResolver

constructor PReferenceResolver.Create;
begin
  inherited;
  ResolveItemList := TList.Create;
  HashedGuidTable := THashedStringList.Create;
  HashedGuidTable.CaseSensitive := True;
  ProgressMaxStep := 10;
end;

destructor PReferenceResolver.Destroy;
begin
  Clear;
  ResolveItemList.Free;
  HashedGuidTable.Free;
  inherited;
end;

function PReferenceResolver.GetResolveItem(Index: Integer): PReferenceResolveItem;
begin
  Result := ResolveItemList.Items[Index];
end;

function PReferenceResolver.GetResolveItemCount: Integer;
begin
  Result := ResolveItemList.Count;
end;

procedure PReferenceResolver.ResolvingProgress(Info: string; Max, Progress: Integer);
var
  P: Integer;
begin
  if Max > 0 then begin
    if Progress = 0 then CurProgress := 0;
    P := Round((Progress / Max) * ProgressMaxStep);
    if Assigned(FOnResolvingProgress) and (P > CurProgress) then
    begin
      CurProgress := P;
      FOnResolvingProgress(Self, Info, ProgressMaxStep, CurProgress);
    end;
  end;
end;

procedure PReferenceResolver.BuildHashedGuidTable;
var
  I, J: Integer;
  MC: PMetaClass;
  E: PElement;
begin
  HashedGuidTable.Clear;
  for I := 0 to MetaModel.MetaClassCount - 1 do
  begin
    MC := MetaModel.MetaClasses[I];
    for J := 0 to MC.InstanceCount - 1 do
    begin
      E := MC.Instances[J];
      HashedGuidTable.AddObject(E.GUID, E);
    end;
  end;
end;

function PReferenceResolver.FindInstance(AGUID: string): PElement;
var
  Idx: Integer;
begin
  Idx := HashedGuidTable.IndexOf(AGUID);
  if Idx < 0 then
    Result := nil
  else
    Result := HashedGuidTable.Objects[Idx] as PElement;
end;

procedure PReferenceResolver.Clear;
var
  I: Integer;
  R: PReferenceResolveItem;
begin
  for I := ResolveItemList.Count - 1 downto 0 do
  begin
    R := ResolveItemList.Items[I];
    R.Free;
  end;
  ResolveItemList.Clear;
end;

procedure PReferenceResolver.AddResolveItem(AElement: PElement; AName, AGUID, APathname: string; AIsCollection: Boolean);
var
  R: PReferenceResolveItem;
begin
  R := PReferenceResolveItem.Create(AElement, AName, AGUID, APathname, AIsCollection);
  ResolveItemList.Add(R);
end;

procedure PReferenceResolver.ResolveAll;
var
  I: Integer;
  R: PReferenceResolveItem;
  Ref: PElement;
  MC: PMetaClass;
  RootModel: PModel;
begin
  // assign Project's instances to RootModel
  // (to find model by Pathname)
  RootModel := nil;
  MC := MetaModel.FindMetaClass('UMLProject');
  if MC <> nil then RootModel := MC.Instances[0] as PModel;
  // correct all references
  ResolvingProgress('', ResolveItemList.Count, 0);

  BuildHashedGuidTable;

  for I := 0 to ResolveItemList.Count - 1 do
  begin
    R := ResolveItemList.Items[I];

    // (1) find reference by GUID
    Ref := FindInstance(R.GUID);
    // (2) if not found by GUID, find by Pathname
    if Ref = nil then begin
      Ref := RootModel.FindByRelativePathname(ExtractTailPath(R.Pathname));
    end;

    // correct reference
    if R.IsCollection then begin
      R.Element.MOF_AddCollectionItem(R.Name, Ref);
    end
    else begin
      R.Element.MOF_SetReference(R.Name, Ref);
    end;
    ResolvingProgress('', ResolveItemList.Count, I+1);
  end;
end;

procedure PReferenceResolver.BlockedResolveAll(BaseElement: PElement);
var
  I, J: Integer;
  R: PReferenceResolveItem;
  Ref: PElement;
  AVisitor: PReferenceCollectionVisitor;
  AnObj: PObject;
begin
  // correct all references
  // referece's target element is limited in BaseElement

  ResolvingProgress('', ResolveItemList.Count, 0);
  AVisitor := PReferenceCollectionVisitor.Create;
  try
    BaseElement.Accept(AVisitor);

    for I := 0 to ResolveItemList.Count - 1 do
    begin
      R := ResolveItemList.Items[I];

      // find reference by GUID
      Ref := nil;
      for J := 0 to AVisitor.ReferenceCount - 1 do begin
        AnObj := AVisitor.References[J];
        if R.GUID = AnObj.GUID then begin
          Ref := AnObj as PElement;
          Break;
        end;
      end;

      // correct reference
      if Ref <> nil then
      begin
        if R.IsCollection then begin
          R.Element.MOF_AddCollectionItem(R.Name, Ref);
        end
        else begin
          R.Element.MOF_SetReference(R.Name, Ref);
        end;
      end;
      
      ResolvingProgress('', ResolveItemList.Count, I+1);
    end;
  finally
    AVisitor.Free;
  end;
end;

procedure PReferenceResolver.ReplaceGUID(OldGUID, NewGUID: string);
var
  I: Integer;
  AnItem: PReferenceResolveItem;
begin
  for I := 0 to ResolveItemCount - 1 do begin
    AnItem := ResolveItems[I] as PReferenceResolveItem;
    if AnItem.GUID = OldGuid then AnItem.GUID := NewGUID;
  end;
end;

procedure PReferenceResolver.ReassignGUIDs(BaseElement: PElement);
var
  AVisitor: PReferenceCollectionVisitor;
  AnObj: PObject;
  OldGUID, NewGUID: string;
  I: Integer;
begin
  AVisitor := PReferenceCollectionVisitor.Create;
  try
    BaseElement.Accept(AVisitor);
    for I := 0 to AVisitor.ReferenceCount - 1 do begin
      AnObj := AVisitor.References[I];
      OldGUID := AnObj.GUID;
      NewGUID := CreateGUIDBase64;
      AnObj.GUID := NewGUID;
      ReplaceGUID(OldGUID, NewGUID);
    end;
  finally
    AVisitor.Free;
  end;
end;

// PReferenceResolver
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PXMLObjectReader

constructor PXMLObjectReader.Create(BaseNode: IXMLNode; AReferenceResolver: PReferenceResolver);
begin
  CurrentNode := BaseNode;
  CurrentObject := nil;
  ReferenceResolver := AReferenceResolver;
  CurrentKeyTable := nil;
  CurrentBuildKeyTable(BaseNode);
end;

destructor PXMLObjectReader.Destroy;
begin
  if CurrentKeyTable <> nil then CurrentKeyTable.Free;
  inherited;
end;

procedure PXMLObjectReader.CurrentBuildKeyTable(BaseNode: IXMLNode);
var
  I: Integer;
  Node: IXMLNode;
  Key: string;
begin
  CurrentKeyTable := THashedStringList.Create;
  CurrentKeyTable.CaseSensitive := True;
  CurrentKeyTable.Clear;
  for I := 0 to BaseNode.ChildNodes.Count - 1 do
  begin
    Node := BaseNode.ChildNodes.Nodes[I];
    Key := Node.Attributes[XPD_NAME];
    CurrentKeyTable.Add(Key);
  end;
end;

function PXMLObjectReader.GetNodeByKey(Key: string): IXMLNode;
var
  Idx: Integer;
begin
  Idx := CurrentKeyTable.IndexOf(Key);
  if Idx < 0 then
    Result := nil
  else
    Result := CurrentNode.ChildNodes.Nodes[Idx];
end;

function PXMLObjectReader.ReadInteger(Key: string; Default: Integer = 0): Integer;
var
  Node: IXMLNode;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return 0(zero).
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_ATTRIBUTE then
    raise EInvalidFileFormat.Create(XPD_ERR_ATTRIBUTE_REQUIRED);
  if Node.Attributes[XPD_TYPE] <> XPD_INTEGER then
    raise EInvalidFileFormat.Create(XPD_ERR_INVALID_INTEGER_TYPE);
  // Read stored value.
  if VarIsNull(Node.NodeValue) then
    Result := Default
  else
    Result := Node.NodeValue;
end;

function PXMLObjectReader.ReadBoolean(Key: string; Default: Boolean = False): Boolean;
var
  Node: IXMLNode;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return False.
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_ATTRIBUTE then
    raise EInvalidFileFormat.Create(XPD_ERR_ATTRIBUTE_REQUIRED);
  if Node.Attributes[XPD_TYPE] <> XPD_BOOLEAN then
    raise EInvalidFileFormat.Create(XPD_ERR_INVALID_BOOLEAN_TYPE);
  // Read stored value.
  if VarIsNull(Node.NodeValue) then
    Result := Default
  else
    Result := Node.NodeValue;
end;

function PXMLObjectReader.ReadReal(Key: string; Default: Real = 0.0): Real;
var
  Node: IXMLNode;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return 0.0.
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_ATTRIBUTE then
    raise EInvalidFileFormat.Create(XPD_ERR_ATTRIBUTE_REQUIRED);
  if Node.Attributes[XPD_TYPE] <> XPD_REAL then
    raise EInvalidFileFormat.Create(XPD_ERR_INVALID_REAL_TYPE);
  // Read stored value.
  if VarIsNull(Node.NodeValue) then
    Result := Default
  else
    Result := Node.NodeValue;
end;

function PXMLObjectReader.ReadString(Key: string; Default: string = ''): string;
var
  Node: IXMLNode;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return ''(null string).
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_ATTRIBUTE then
    raise EInvalidFileFormat.Create(XPD_ERR_ATTRIBUTE_REQUIRED);
  if Node.Attributes[XPD_TYPE] <> XPD_STRING then
    raise EInvalidFileFormat.Create(XPD_ERR_INVALID_STRING_TYPE);
  // Read stored value.
  if VarIsNull(Node.NodeValue) then
    Result := Default
  else
    Result := Node.NodeValue;
end;

function PXMLObjectReader.ReadObject(Key: string; Default: PObject = nil): PObject;
var
  Node, TempNode: IXMLNode;
  TempObj: PObject;
  GUID, ClassName: string;
  Obj: PObject;
  TempKeyTable: THashedStringList;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return nil.
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_OBJECT then
    raise EInvalidFileFormat.Create(XPD_ERR_OBJECT_REQUIRED);
  // Read GUID and ClassName
  GUID := Node.Attributes[XPD_GUID];
  ClassName := Node.Attributes[XPD_TYPE];
  // Create object of NewClass and set GUID.
  Obj := MetaModel.CreateInstance(ClassName, GUID);
  TempNode := CurrentNode;
  TempObj := CurrentObject;
  CurrentNode := Node;
  CurrentObject := Obj;
  TempKeyTable := CurrentKeyTable;
  CurrentBuildKeyTable(CurrentNode);
  // Load Obj recursively.
  Obj.Load(Self);
  CurrentNode := TempNode;
  CurrentObject := TempObj;
  if CurrentKeyTable <> nil then CurrentKeyTable.Free;
  CurrentKeyTable := TempKeyTable;
  Result := Obj;
end;

function PXMLObjectReader.ReadReference(Key: string; Default: PObject = nil): PObject;
var
  Node: IXMLNode;
  GUID, Pathname: string;
  Obj: PObject;
  RefName: string;
  IsCol: Boolean;
begin
  Obj := nil;
  Node := GetNodeByKey(Key);
  // If Key is not found, return nil.
  if Node = nil then
  begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_REFERENCE then
    raise EInvalidFileFormat.Create(XPD_ERR_REFERENCE_REQUIRED);
  // Read GUID
  if VarIsNull(Node.NodeValue) then
    GUID := ''
  else
    GUID := Node.NodeValue;
  // Read Pathname
  if VarIsNull(Node.Attributes[XPD_PATHNAME]) then
    Pathname := ''
  else
    Pathname := Node.Attributes[XPD_PATHNAME];
  // decide whether reference which will be read is kind of collection or not
  if IsCollectionKey(Key) then
  begin
    IsCol := True;
    RefName := TrimCollectionKey(Key);
  end
  else begin
    IsCol := False;
    RefName := Key;
  end;
  // Add A ResolveItem to ReferenceResolver.
  ReferenceResolver.AddResolveItem(CurrentObject as PElement, RefName, GUID, Pathname, IsCol);
  Result := Obj;
end;

function PXMLObjectReader.ReadUserDefinedType(TypeName, Key: string; Default: string = ''): string;
var
  Node: IXMLNode;
begin
  Node := GetNodeByKey(Key);
  // If Key is not found, return ''(null string).
  if Node = nil then begin
    Result := Default;
    Exit;
  end;
  // Check validation.
  if Node.LocalName <> XPD_ATTRIBUTE then
    raise EInvalidFileFormat.Create(XPD_ERR_ATTRIBUTE_REQUIRED);
  if Node.Attributes[XPD_TYPE] <> TypeName then
    raise EInvalidFileFormat.Create(XPD_ERR_INVALID_USERDEFINED_TYPE + '(' + TypeName + ' is required)');
  // Read stored value.
  if VarIsNull(Node.NodeValue) then
    Result := Default
  else
    Result := Node.NodeValue;
end;

// PXMLObjectReader
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PXMLObjectWriter

constructor PXMLObjectWriter.Create(AXMLStrings: TStrings);
begin
  XMLStrings := AXMLStrings;
  CurrentObject := nil;
  CurrentDocument := nil;
end;

function PXMLObjectWriter.GetAttrBeginNode(Name, TypeName: string): string;
var
  S: string;
begin
  S := '<' + XPD_PREFIX + ':' + XPD_ATTRIBUTE;
  S := S + ' ' + XPD_NAME + '="' + Name + '"';
  S := S + ' ' + XPD_TYPE + '="' + TypeName + '"';
  S := S + '>';
  Result := S;
end;

function PXMLObjectWriter.GetAttrEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + XPD_ATTRIBUTE + '>'
end;

function PXMLObjectWriter.GetObjBeginNode(Name, TypeName, Guid: string): string;
var
  S: string;
begin
  S := '<' + XPD_PREFIX + ':' + XPD_OBJECT;
  S := S + ' ' + XPD_NAME + '="' + Name + '"';
  S := S + ' ' + XPD_TYPE + '="' + TypeName + '"';
  S := S + ' ' + XPD_GUID + '="' + Guid + '"';
  S := S + '>';
  Result := S;
end;

function PXMLObjectWriter.GetObjEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + XPD_OBJECT + '>'
end;

function PXMLObjectWriter.GetRefBeginNode(Name: string; Pathname: string = ''): string;
var
  S: string;
begin
  S := '<' + XPD_PREFIX + ':' + XPD_REFERENCE;
  S := S + ' ' + XPD_NAME + '="' + Name + '"';
  if Pathname <> '' then
    S := S + ' ' + XPD_PATHNAME + '="' + HTMLEncode(UTF8Encode(Pathname)) + '"';
  S := S + '>';
  Result := S;
end;

function PXMLObjectWriter.GetRefEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + XPD_REFERENCE + '>'
end;

function PXMLObjectWriter.IsFiltered(Key: string): Boolean;
var
  CanFilter: Boolean;
begin
  CanFilter := False;
  if Assigned(FOnFilter) then
    FOnFilter(Self, CurrentObject, Key, CanFilter);
  Result := CanFilter;
end;

procedure PXMLObjectWriter.WriteInteger(Key: string; Value: Integer; Default: Integer = 0);
var
  Attr: string;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      Attr := GetAttrBeginNode(Key, XPD_INTEGER) + IntegerToString(Value) + GetAttrEndNode;
      XMLStrings.Add(Attr);
    end;
  end;
end;

procedure PXMLObjectWriter.WriteBoolean(Key: string; Value: Boolean; Default: Boolean = False);
var
  Attr: string;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      Attr := GetAttrBeginNode(Key, XPD_BOOLEAN) + BooleanToString(Value) + GetAttrEndNode;
      XMLStrings.Add(Attr);
    end;
  end;
end;

procedure PXMLObjectWriter.WriteReal(Key: string; Value: Real; Default: Real = 0.0);
var
  Attr: string;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      Attr := GetAttrBeginNode(Key, XPD_REAL) + RealToString(Value) + GetAttrEndNode;
      XMLStrings.Add(Attr);
    end;
  end;
end;

procedure PXMLObjectWriter.WriteString(Key: string; Value: string; Default: string = '');
var
  Attr: string;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      Attr := GetAttrBeginNode(Key, XPD_STRING) + HTMLEncode(UTF8Encode(Value)) + GetAttrEndNode;
      XMLStrings.Add(Attr);
    end;
  end;
end;

procedure PXMLObjectWriter.WriteObject(Key: string; Value: PObject; Default: PObject = nil);
var
  TempObj: PObject;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      XMLStrings.Add(GetObjBeginNode(Key, (Value as PElement).MetaClass.Name, Value.GUID));
      TempObj := CurrentObject;
      CurrentObject := Value;
      if CurrentObject is PElement then
        CurrentDocument := (CurrentObject as PElement).GetContainingDocument;
      CurrentObject.Store(Self);
      CurrentObject := TempObj;
      if CurrentObject is PElement then
        CurrentDocument := (CurrentObject as PElement).GetContainingDocument;
      XMLStrings.Add(GetObjEndNode);
    end;
  end;
end;

procedure PXMLObjectWriter.WriteReference(Key: string; Value: PObject; Default: PObject = nil);
var
  Ref: string;
  D: PDocument;
begin
  D := nil;
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      if Value = nil then begin
        Ref := GetRefBeginNode(Key) + GetRefEndNode;
        XMLStrings.Add(Ref);
      end
      else begin
        if Value is PElement then
          D := (Value as PElement).GetContainingDocument;
        // if value is PModel and save value in different document, save with Pathname
        if (Value is PModel) and (CurrentDocument <> D) then
        begin
          Ref := GetRefBeginNode(Key, (Value as PModel).Pathname)+ Value.GUID + GetRefEndNode;
          XMLStrings.Add(Ref);
        end
        else begin
          Ref := GetRefBeginNode(Key)+ Value.GUID + GetRefEndNode;
          XMLStrings.Add(Ref);
        end;
      end;
    end;
  end;
end;

procedure PXMLObjectWriter.WriteUserDefinedType(TypeName, Key, Value: string; Default: string = '');
var
  Attr: string;
begin
  if not IsFiltered(Key) then begin
    if Value <> Default then begin
      Attr := GetAttrBeginNode(Key, TypeName) + Value + GetAttrEndNode;
      XMLStrings.Add(Attr);
    end;
  end;
end;

// PXMLObjectWriter
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PXMLDOMObjectWriter

constructor PXMLDOMObjectWriter.Create(BaseNode: IXMLNode);
begin
  CurrentNode := BaseNode;
  CurrentObject := nil;
  CurrentDocument := nil;
end;

procedure PXMLDOMObjectWriter.WriteInteger(Key: string; Value: Integer; Default: Integer = 0);
var
  AttrNode: IXMLNode;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_ATTRIBUTE, XPD_NAMESPACE_URI);
    AttrNode.Attributes[XPD_NAME] := Key;
    AttrNode.Attributes[XPD_TYPE] := XPD_INTEGER;
    AttrNode.NodeValue := Value;
  end;
end;

procedure PXMLDOMObjectWriter.WriteBoolean(Key: string; Value: Boolean; Default: Boolean = False);
var
  AttrNode: IXMLNode;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_ATTRIBUTE, XPD_NAMESPACE_URI);
    AttrNode.Attributes[XPD_NAME] := Key;
    AttrNode.Attributes[XPD_TYPE] := XPD_BOOLEAN;
    AttrNode.NodeValue := Value;
  end;
end;

procedure PXMLDOMObjectWriter.WriteReal(Key: string; Value: Real; Default: Real = 0.0);
var
  AttrNode: IXMLNode;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_ATTRIBUTE, XPD_NAMESPACE_URI);
    AttrNode.Attributes[XPD_NAME] := Key;
    AttrNode.Attributes[XPD_TYPE] := XPD_REAL;
    AttrNode.NodeValue := Value;
  end;
end;

procedure PXMLDOMObjectWriter.WriteString(Key: string; Value: string; Default: string = '');
var
  AttrNode: IXMLNode;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_ATTRIBUTE, XPD_NAMESPACE_URI);
    AttrNode.Attributes[XPD_NAME] := Key;
    AttrNode.Attributes[XPD_TYPE] := XPD_STRING;
    AttrNode.NodeValue := Value;
  end;
end;

procedure PXMLDOMObjectWriter.WriteObject(Key: string; Value: PObject; Default: PObject = nil);
var
  ObjNode: IXMLNode;
  TempNode: IXMLNode;
  TempObj: PObject;
begin
  if Value <> Default then begin
    ObjNode := CurrentNode.AddChild(XPD_OBJECT, XPD_NAMESPACE_URI);
    ObjNode.Attributes[XPD_NAME] := Key;
    ObjNode.Attributes[XPD_TYPE] := (Value as PElement).MetaClass.Name;
    ObjNode.Attributes[XPD_GUID] := Value.GUID;
    TempNode := CurrentNode;
    TempObj := CurrentObject;
    CurrentNode := ObjNode;
    CurrentObject := Value;
    if CurrentObject is PElement then
      CurrentDocument := (CurrentObject as PElement).GetContainingDocument;
    Value.Store(Self);
    CurrentNode := TempNode;
    CurrentObject := TempObj;
    if CurrentObject is PElement then
      CurrentDocument := (CurrentObject as PElement).GetContainingDocument;
  end;
end;

procedure PXMLDOMObjectWriter.WriteReference(Key: string; Value: PObject; Default: PObject = nil);
var
  AttrNode: IXMLNode;
  D: PDocument;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_REFERENCE);
    AttrNode.Attributes[XPD_NAME] := Key;
    if Value = nil then begin
      AttrNode.NodeValue := '';
      AttrNode.Attributes[XPD_PATHNAME] := '';
    end
    else begin
      D := nil;
      if Value is PElement then
        D := (Value as PElement).GetContainingDocument;
      // if Value is PModel and save value in different Document, save with Pathname
      if (Value is PModel) and (CurrentDocument <> D) then
        AttrNode.Attributes[XPD_PATHNAME] := (Value as PModel).Pathname;
      AttrNode.NodeValue := Value.GUID;
    end;
  end;
end;

procedure PXMLDOMObjectWriter.WriteUserDefinedType(TypeName, Key, Value: string; Default: string = '');
var
  AttrNode: IXMLNode;
begin
  if Value <> Default then begin
    AttrNode := CurrentNode.AddChild(XPD_ATTRIBUTE, XPD_NAMESPACE_URI);
    AttrNode.Attributes[XPD_NAME] := Key;
    AttrNode.Attributes[XPD_TYPE] := TypeName;
    AttrNode.NodeValue := Value;
  end;
end;

// PXMLDOMObjectWriter
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDocument

constructor PDocument.Create;
begin
  inherited;
  FFileName := '';
  FVersion := '1.0';
  FModified := False;
  FReadOnly := False;
  FFileSavedTime := 0;
  FExternallyModified := False;
  FDocumentElement := nil;
  FOnModified := nil;
  FOnSaved := nil;
end;

destructor PDocument.Destroy;
begin
  DocumentElement := nil;
  inherited;
end;

procedure PDocument.UpdateFileAttr;
var
  DT: TDateTime;
  Attr: Integer;
begin
  if FileExists(FFileName) then begin
    DT := FileDateToDateTime(FileAge(FFileName));
    if (FFileSavedTime <> 0) and (FFileSavedTime <> DT) then
      FExternallyModified := True;
    FFileSavedTime := DT;
    Attr := FileGetAttr(FileName);
    FReadOnly := (Attr and faReadOnly) = faReadOnly;
  end
  else if FFileName <> '' then begin
    FModified := True;
    FReadOnly := False;
  end;
end;

function PDocument.GetDocumentSymbol: string;
begin
  Result := '';
end;

procedure PDocument.SetModified(Value: Boolean);
begin
  if FModified <> Value then
  begin
    FModified := Value;
    if FModified then begin
      if Assigned(FOnModified) then FOnModified(Self, Self);
    end
    else begin
      if Assigned(FOnSaved) then FOnSaved(Self, Self);
    end;
  end;
end;

procedure PDocument.SetDocumentElement(Value: PElement);
begin
  if FDocumentElement <> Value then begin
    if FDocumentElement <> nil then FDocumentElement.FDocument := nil;
    FDocumentElement := Value;
    if FDocumentElement <> nil then FDocumentElement.FDocument := Self;
  end;
end;

// PDocument
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDocumentInputStream

constructor PDocumentInputStream.Create(AFileName: string; AReferenceResolver: PReferenceResolver);
begin
  FFileName := ExpandFileName(AFileName);
  XMLDoc := TXMLDocument.Create(Application);
  XMLDoc.ParseOptions := [poAsyncLoad];
  XMLDoc.OnAsyncLoad := AsyncLoadHandler;
  FReferenceResolver := AReferenceResolver;
end;

destructor PDocumentInputStream.Destroy;
begin
  XMLDoc.Free;
  FReferenceResolver := nil;
  inherited;
end;

procedure PDocumentInputStream.AsyncLoadHandler(Sender: TObject; AsyncLoadState: Integer);
begin
  LoadingProgress(FFileName, MAX_ASYNC_LOAD_STATE + 2, AsyncLoadState + 1);
end;

procedure PDocumentInputStream.LoadingProgress(Info: string; Max, Progress: Integer);
begin
  if Assigned(FOnLoadingProgress) then
    FOnLoadingProgress(Self, Info, Max, Progress);
end;

procedure PDocumentInputStream.ReadHeader(HeaderNode: IXMLNode);
begin
  // Nothing to read in header part
end;

procedure PDocumentInputStream.ReadBody(BodyNode: IXMLNode);
var
  Reader: PObjectReader;
begin
  // Read structure of objects.
  Reader := PXMLObjectReader.Create(BodyNode, FReferenceResolver);
  DocumentElement := Reader.ReadObject(XPD_DOCUMENT_ELEMENT) as PElement;
  Reader.Free;
end;

function PDocumentInputStream.ReadDocument: PDocument;
var
  DocumentSymbol: string;
  Version: string;
  HeaderNode: IXMLNode;
  BodyNode: IXMLNode;
  ADocument: PDocument;
  CurDir: string;
begin
  // Check the file existence.
  if not FileExists(FFileName) then
    raise EFileNotFound.Create(Format(ERR_FILE_NOT_FOUND, [FFileName]));
  // Store CurrentDir and Change CurrentDir to path of the FileName.
  CurDir := GetCurrentDir;
  ChDir(ExtractFilePath(FFileName));
  // Load the file.
  LoadingProgress(FFileName, MAX_ASYNC_LOAD_STATE + 2, 0);
  XMLDoc.LoadFromFile(FFileName);
  XMLDoc.Active := True;
  DocumentSymbol := XMLDoc.DocumentElement.LocalName;
  Version := XMLDoc.DocumentElement.Attributes[XPD_VERSION];
  HeaderNode := XMLDoc.DocumentElement.ChildNodes.Nodes[XPD_HEADER];
  BodyNode := XMLDoc.DocumentElement.ChildNodes.Nodes[XPD_BODY];
  ReadHeader(HeaderNode);
  LoadingProgress(FFileName, MAX_ASYNC_LOAD_STATE + 2, MAX_ASYNC_LOAD_STATE + 1);
  ReadBody(BodyNode);
  ADocument := CreateDocument;
  ADocument.FileName := FileName;
  ADocument.Version := Version;
  ADocument.DocumentElement := DocumentElement;
  ADocument.UpdateFileAttr;
  LoadingProgress(FFileName, MAX_ASYNC_LOAD_STATE + 2, MAX_ASYNC_LOAD_STATE + 2);
  Result := ADocument;
  // Restore CurrentDir
  ChDir(CurDir);
end;

// PDocumentInputStream
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDocumentOutputStream

constructor PDocumentOutputStream.Create(AFileName: string);
var
  H: string;
begin
  FFileName := AFileName;
  H := '<?xml version="' + DEFAULT_XML_VERSION + '"'
    + ' encoding="' + DEFAULT_XML_ENCODING + '"?>';
  XMLStrings := TStringList.Create;
  XMLStrings.Add(H);
end;

destructor PDocumentOutputStream.Destroy;
begin
  XMLStrings.Free;
  inherited;
end;

function PDocumentOutputStream.GetDocBeginNode: string;
var
  S: string;
begin
  S := '<' + XPD_PREFIX + ':' + GetDocumentSymbol;
  S := S + ' xmlns:' + XPD_PREFIX + '="' + XPD_NAMESPACE_URI + '"';
  S := S + ' ' + XPD_VERSION + '="' + IntegerToString(GetDocumentVersion) + '"';
  S := S + '>';
  Result := S;
end;

function PDocumentOutputStream.GetDocEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + GetDocumentSymbol + '>';
end;

function PDocumentOutputStream.GetHeaderBeginNode: string;
begin
  Result := '<' + XPD_PREFIX + ':' + XPD_HEADER + '>';
end;

function PDocumentOutputStream.GetHeaderEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + XPD_HEADER + '>';
end;

function PDocumentOutputStream.GetBodyBeginNode: string;
begin
  Result := '<' + XPD_PREFIX + ':' + XPD_BODY + '>';
end;

function PDocumentOutputStream.GetBodyEndNode: string;
begin
  Result := '</' + XPD_PREFIX + ':' + XPD_BODY + '>';
end;

procedure PDocumentOutputStream.SavingProgress(Info: string; Max, Progress: Integer);
begin
  if Assigned(FOnSavingProgress) then
    FOnSavingProgress(Self, Info, Max, Progress);
end;

procedure PDocumentOutputStream.FilterHandler(Sender: TObject;
  CurrentObject: PObject; Key: string; var CanFilter: Boolean);
begin
  IsFiltered(CurrentObject, Key, CanFilter);  
end;

function PDocumentOutputStream.GetDocumentSymbol: string;
begin
  Result := 'DOCUMENT';
end;

function PDocumentOutputStream.GetDocumentVersion: Integer;
begin
  Result := 1;
end;

procedure PDocumentOutputStream.IsFiltered(Obj: PObject; Key: string; var CanFilter: Boolean);
begin
end;

procedure PDocumentOutputStream.WriteHeader(ADocument: PDocument);
begin
  // Nothing to write in header part
end;

procedure PDocumentOutputStream.WriteBody(ADocument: PDocument);
var
  Writer: PXMLObjectWriter;
begin
  // PRECONDTIIONS
  Assert(ADocument <> nil);
  // PRECONDTIIONS
  Writer := PXMLObjectWriter.Create(XMLStrings);
  Writer.OnFilter := FilterHandler;
  Writer.WriteObject(XPD_DOCUMENT_ELEMENT, ADocument.DocumentElement);
  Writer.Free;
end;

procedure PDocumentOutputStream.Close(ADocument: PDocument);
begin
  XMLStrings.SaveToFile(FFileName);
  ADocument.FileSavedTime := FileDateToDateTime(FileAge(ADocument.FileName));
end;

procedure PDocumentOutputStream.WriteDocument(ADocument: PDocument);
var
  CurDir: string;
begin
  ADocument.UpdateFileAttr;
  if ADocument.ReadOnly then
    raise EReadOnlyFile.Create(Format(ERR_SAVE_READONLY_FILE, [ExtractFileName(ADocument.FileName)]));
  if ADocument <> nil then
  begin
    // Store CurrentDir and Move to path of the FileName
    CurDir := GetCurrentDir;
    ChDir(ExtractFilePath(FFileName));
    // Save the file
    SavingProgress(FFileName, 2, 0);
    XMLStrings.Add(GetDocBeginNode);
    XMLStrings.Add(GetHeaderBeginNode);
    WriteHeader(ADocument);
    XMLStrings.Add(GetHeaderEndNode);
    SavingProgress(FFileName, 2, 1);
    XMLStrings.Add(GetBodyBeginNode);
    WriteBody(ADocument);
    XMLStrings.Add(GetBodyEndNode);
    XMLStrings.Add(GetDocEndNode);
    ADocument.Modified := False;
    SavingProgress(FFileName, 2, 2);
    // Restore CurrentDir
    ChDir(CurDir);
  end;
end;

// PDocumentOutputStream
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PDocumentOutputStream__

{
constructor PDocumentOutputStream__.Create(AFileName: string);
begin
  FFileName := AFileName;
  XMLDoc := TXMLDocument.Create(Application);
  XMLDoc.Encoding := DEFAULT_XML_ENCODING;
  XMLDoc.Active := True;
end;

destructor PDocumentOutputStream__.Destroy;
begin
  XMLDoc.Free;
  XMLDoc := nil;
  inherited;
end;

function PDocumentOutputStream__.GetDocumentSymbol: string;
begin
  Result := 'DOCUMENT';
end;

function PDocumentOutputStream__.GetDocumentVersion: Integer;
begin
  Result := 1;
end;

procedure PDocumentOutputStream__.WriteHeader(HeaderNode: IXMLNode; ADocument: PDocument);
begin
  // Nothing to write in header part
end;

procedure PDocumentOutputStream__.WriteBody(BodyNode: IXMLNode; ADocument: PDocument);
var
  Writer: PObjectWriter;
begin
  // PRECONDTIIONS
  Assert(BodyNode <> nil);
  Assert(ADocument <> nil);
  // PRECONDTIIONS
  Writer := PXMLDOMObjectWriter.Create(BodyNode);
  Writer.WriteObject(XPD_DOCUMENT_ELEMENT, ADocument.DocumentElement);
  Writer.Free;
end;

procedure PDocumentOutputStream__.Close;
begin
  XMLDoc.SaveToFile(FFileName);
end;

procedure PDocumentOutputStream__.WriteDocument(ADocument: PDocument);
var
  HeaderNode: IXMLNode;
  BodyNode: IXMLNode;
begin
  // PRECONDTIIONS
  Assert(ADocument <> nil);
  // PRECONDTIIONS
  XMLDoc.DocumentElement := XMLDoc.AddChild(XPD_PREFIX + ':' + GetDocumentSymbol);
  XMLDoc.DocumentElement.DeclareNamespace(XPD_PREFIX, XPD_NAMESPACE_URI);
  XMLDoc.DocumentElement.Attributes[XPD_VERSION] := GetDocumentVersion;
  HeaderNode := XMLDoc.DocumentElement.AddChild(XPD_HEADER, XPD_NAMESPACE_URI);
  BodyNode := XMLDoc.DocumentElement.AddChild(XPD_BODY, XPD_NAMESPACE_URI);
  WriteHeader(HeaderNode, ADocument);
  WriteBody(BodyNode, ADocument);
end;
}

// PDocumentOutputStream__
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// PrimitiveType Conversion Routines

function BooleanToString(B: Boolean): string;
begin
  if B then Result := 'True' else Result := 'False';
end;

function StringToBoolean(S: string): Boolean;
begin
  if S = 'True' then Result := True else Result := False;
end;

function IntegerToString(I: Integer): string;
begin
  Result := IntToStr(I);
end;

function StringToInteger(S: string): Integer;
begin
  Result := StrToInt(S);
end;

function RealToString(R: Real): string;
begin
  Result := FloatToStr(R);
end;

function StringToReal(S: string): Real;
begin
  Result := StrToFloat(S);
end;

function RectToString(ARect: TRect): string;
const
  DELIMITER = ',';
begin
  Result := IntToStr(ARect.Left) +
    DELIMITER + IntToStr(ARect.Top) +
    DELIMITER + IntToStr(ARect.Right) +
    DELIMITER + IntToStr(ARect.Bottom);
end;

function StringToRect(RectStr: string): TRect;
const
  DELIMITER = ',';
var
  Fields: TStringList;
begin
  Fields := TStringList.Create;
  Fields.Delimiter := DELIMITER;
  Fields.DelimitedText := RectStr;
  Result := Rect(
    StrToInt(Fields.Strings[0]),
    StrToInt(Fields.Strings[1]),
    StrToInt(Fields.Strings[2]),
    StrToInt(Fields.Strings[3]));
  Fields.Free;
end;

// PrimitiveType Conversion Routines
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Procedures and Functions

function ExtractHeadName(Pathname: string): string;
var
  Idx: Integer;
begin
  Idx := Pos(PATH_DELIMITER, Pathname);
  if Idx = 0 then
    Result := Pathname
  else
    Result := Copy(Pathname, 0, Idx - 1);
end;

function ExtractTailPath(Pathname: string): string;
var
  Idx: Integer;
begin
  Idx := Pos(PATH_DELIMITER, Pathname);
  if Idx = 0 then
    Result := ''
  else
    Result := Copy(Pathname, Idx + 2, Length(Pathname) - Idx - 1);
end;

procedure CheckNameValidity(Name: string);
begin
  if Pos('::', Name) > 0 then begin
    raise EInvalidName.Create(ERR_ELEM_INVALID_NAME);
  end;    
end;

procedure CheckReadOnly(ElementSet: POrderedSet);
var
  I: Integer;
begin
  for I := 0 to ElementSet.Count - 1 do
    CheckReadOnly(ElementSet.Items[I] as PElement);
end;

procedure CheckReadOnly(Element: PElement);
var
  Doc: PDocument;
begin
  if Element <> nil then begin
    Doc := Element.GetContainingDocument;
    if (Doc <> nil) and (Doc.ReadOnly) then
      raise EReadOnlyDocument.Create(ERR_READONLY);
  end;
end;


// Procedures and Functions
////////////////////////////////////////////////////////////////////////////////

procedure RegisterClasses;
begin
  ClassRegistry.RegisterClass(PElement);
  ClassRegistry.RegisterClass(PModel);
  ClassRegistry.RegisterClass(PView);
  ClassRegistry.RegisterClass(PDiagram);
  ClassRegistry.RegisterClass(PDiagramView);
  ClassRegistry.RegisterClass(PMetaElement);
  ClassRegistry.RegisterClass(PMetaClassifier);
  ClassRegistry.RegisterClass(PMetaSlot);
  ClassRegistry.RegisterClass(PMetaAttribute);
  ClassRegistry.RegisterClass(PMetaAssociationEnd);
  ClassRegistry.RegisterClass(PMetaReference);
  ClassRegistry.RegisterClass(PMetaCollection);
  ClassRegistry.RegisterClass(PMetaClass);
  ClassRegistry.RegisterClass(PMetaLiteral);
  ClassRegistry.RegisterClass(PMetaEnumeration);
  ClassRegistry.RegisterClass(PMetaPrimitiveType);
  ClassRegistry.RegisterClass(PMetaDataType);
  ClassRegistry.RegisterClass(PMetaModel);
  ClassRegistry.RegisterClass(PDocument);
end;

procedure RegisterMetaClasses;
var
  M: PMetaClass;
begin
  // Meta Classes
  MetaModel.DefineMetaClass(PElement, 'Element', True);
  MetaModel.DefineMetaClass(PModel, 'Model', True);
  MetaModel.DefineMetaClass(PView, 'View', True);
  MetaModel.DefineMetaClass(PDiagram, 'Diagram', True);
  MetaModel.DefineMetaClass(PDiagramView, 'DiagramView', True);
  // Element
  M := MetaModel.FindMetaClass('Element');
  MetaModel.DefineMetaAttribute(M, 'Tag', 'String', False, False);
  M.Superclass := nil;
  // Model
  M := MetaModel.FindMetaClass('Model');
  MetaModel.DefineMetaAttribute(M, 'Name', 'String', False, False);
  MetaModel.DefineMetaAttribute(M, 'Documentation', 'String', False, False);
  MetaModel.DefineMetaAttribute(M, 'Attachments', 'String', True, False);
  MetaModel.DefineMetaAttribute(M, 'Pathname', 'String', True, True);
  MetaModel.DefineMetaCollection(M, 'Views', 'View', False, False, makNone, 'Model', maeReference);
  MetaModel.DefineMetaCollection(M, 'OwnedDiagrams', 'Diagram', False, False, makComposite, 'DiagramOwner', maeReference);
  // View
  M := MetaModel.FindMetaClass('View');
  MetaModel.DefineMetaAttribute(M, 'LineColor', 'String', False, False, 'clBlack');
  MetaModel.DefineMetaAttribute(M, 'FillColor', 'String', False, False, 'clWhite');
  MetaModel.DefineMetaAttribute(M, 'FontFace', 'String', False, False, 'Tahoma');
  MetaModel.DefineMetaAttribute(M, 'FontSize', 'Integer', False, False, '8');
  MetaModel.DefineMetaAttribute(M, 'FontColor', 'String', False, False, 'clBlack');
  MetaModel.DefineMetaAttribute(M, 'FontStyle', 'Integer', True, False);
  MetaModel.DefineMetaAttribute(M, 'Visible', 'Boolean', True, False, 'True');
  MetaModel.DefineMetaAttribute(M, 'Enabled', 'Boolean', True, False, 'True');
  MetaModel.DefineMetaAttribute(M, 'Selected', 'Boolean', False, True);
  MetaModel.DefineMetaReference(M, 'Model', 'Model', False, False, makNone, 'Views', maeCollection);
  MetaModel.DefineMetaReference(M, 'OwnerDiagramView', 'DiagramView', False, False, makNone, 'OwnedViews', maeCollection);
  MetaModel.DefineMetaReference(M, 'ContainerView', 'View', False, False, makNone, 'ContainedViews', maeCollection);
  MetaModel.DefineMetaCollection(M, 'ContainedViews', 'View', False, False, makComposite, 'ContainerView', maeReference);
  // Diagram
  M := MetaModel.FindMetaClass('Diagram');
  MetaModel.DefineMetaAttribute(M, 'DefaultDiagram', 'Boolean', False, False);
  MetaModel.DefineMetaAttribute(M, 'DiagramType', 'String', False, False);
  MetaModel.DefineMetaReference(M, 'DiagramOwner', 'Model', False, False, makNone, 'OwnedDiagrams', maeCollection);
  MetaModel.DefineMetaReference(M, 'DiagramView', 'DiagramView', True, False, makComposite, 'Diagram', maeReference);
  // DiagramView
  M := MetaModel.FindMetaClass('DiagramView');
  MetaModel.DefineMetaCollection(M, 'SelectedViews', 'View', True, True, makNone);
  MetaModel.DefineMetaReference(M, 'Diagram', 'Diagram', True, False, makNone, 'DiagramView', maeReference);
  MetaModel.DefineMetaCollection(M, 'OwnedViews', 'View', False, False, makComposite, 'OwnerDiagramView', maeReference);
  // Inheritance Relations
  MetaModel.DefineMetaInheritance('Element', 'Model');
  MetaModel.DefineMetaInheritance('Element', 'View');
  MetaModel.DefineMetaInheritance('Model', 'Diagram');
  MetaModel.DefineMetaInheritance('View', 'DiagramView');
end;

initialization
  RegisterClasses;
  MetaModel := PMetaModel.Create;
  MetaModel.Name := 'UML';
  MetaModel.DefineMetaPrimitiveType('Integer');
  MetaModel.DefineMetaPrimitiveType('Real');
  MetaModel.DefineMetaPrimitiveType('Boolean');
  MetaModel.DefineMetaPrimitiveType('String');
  RegisterMetaClasses;
finalization
  MetaModel.Free;
end.


