ubaseidents.pas

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

    procedure Save(Stream: TIdentStream); override;
    //Loads the identifier from the stream.
    procedure Load(Stream: TIdentStream; Version: TIdentClassVersion);
                                                                      override;
    //Compares this identifier with the other one.
    function CompareWith(Ident: TIdentifier; const MsgPrefix: String;
                         Messages: TStrings): Boolean; override;


    property DefIdent: String read FDefIdent write FDefIdent;
    property TheType: TType read FTheType write FTheType;
  end;




   { * * *  ***  * * *  ***   TPackableType   ***  * * *  ***  * * *  }


  {The abstract base class for all structured types that can be packed, i.e.
   declared with the reserved word packed. }
  TPackableType = class(TType)
  private
    //if the type is packed
    FIsPacked: Boolean;
  protected
    //Copies all data of this identifier to the Clone.
    procedure CloneTo(Clone: TIdentifier); override;
  public
    //Gets a description of the identifier, mostly like it has been declared in
    //the pascal data.
    function GetDescriptionString(TextFormat: TTextFormat;
                                  SourceIdent: TIdentifier = nil): String;
                                                                      override;
    //Gets the declaration of the identifier in an internal representation.
    procedure GetDeclaration(Assembly: TDeclarationAssembler); override;

    //Tests if this identifier is equal to Other as regards content.
    function ParamEqualTo(Other: TType): Boolean; override;


    //Saves the identifier to the stream.
    procedure Save(Stream: TIdentStream); override;
    //Loads the identifier from the stream.
    procedure Load(Stream: TIdentStream; Version: TIdentClassVersion);
                                                                      override;
    //Compares this identifier with the other one.
    function CompareWith(Ident: TIdentifier; const MsgPrefix: String;
                         Messages: TStrings): Boolean; override;


    property IsPacked: Boolean read FIsPacked write FIsPacked;
  end;









   { * * *  ***  * * *  ***   TRecordType   ***  * * *  ***  * * *  }



  {A record case of a variant part of a record.}
  TRecordCase = class
  private
    //the list of constants of this case
    FCaseClause: String;
    //all declared identifiers in this case
    FIdentList: TIdentifierList;

    //identifier/type of cases in this case
    FCaseIdentifier: TIdentifier;
    //list of TRecordCase's in this case
    FCasesList: TList;
  public
    //Creates the record case.
    constructor Create;
    //Frees the object.
    destructor Destroy; override;


    //Returns if the identifier is declared in this case and if it is a case
    //field.
    function IsInCase(Ident: TIdentifier; var IsACaseField: Boolean): Boolean;


    //Adds itself and all owned identifiers to the list.
    procedure AddToList(List: TIdentifierList);
    //Saves the identifiers to the stream.
    procedure Save(Stream: TIdentStream);
    //Loads the identifiers from the stream.
    procedure Load(Stream: TIdentStream; Version: TIdentClassVersion);

    //Compares the record-cases with the other ones.
    function CompareWith(Other: TRecordCase): Boolean;


    property CaseClause: String read FCaseClause write FCaseClause;
    property IdentList: TIdentifierList read FIdentList;
    property CaseIdentifier: TIdentifier read FCaseIdentifier
                                         write FCaseIdentifier;
    property CasesList: TList read FCasesList;
  end;





  {The class for all record-like types, this means records, classes by the
   object- and class-model, interfaces and dispatch interfaces. For classes by
   the class-model the initial scope is unknown, because it depends on the
   compiler switch $M and the parent classes, that will only be known at a
   later stage of the parsing, so it is alwas treated as public and not
   published.
   
   The class has a list of all identifiers (fields, methods and properties)
   declared in it. Another identifier for the parent and a field for the GUID
   (if it is an interface) and a list for all implemented interfaces in case it
   is a class. In case it is an interface all known implementing classes will
   be added to this list. It contains also a list of all known direct
   subclasses. }
  TRecordType = class(TPackableType)
  private
    //the kind of type (record, class, interface, ...)
    FKind: TRecordKind;

    //all declared identifiers in this type
    FIdentList: TIdentifierList;

    //the parent/base class
    FParent: TIdentType;

    //the GUID (Global Unique IDentifier) of the interface
    FGUID: String;

    //class:     list of all implemented interfaces;~[br]
    //interface: list of all direct implementing classes;~[br]
    //else:      empty
    FImplementing: TIdentifierList;

    //all known direct subclasses
    FChildren: TIdentifierList;

    //the variant parts of the record
    FVariantCases: TRecordCase;

    //if it starts without setting a scope
    FStartsWithoutScope: Boolean;

    //only for class'es: whether it is still abstract
    FIsAbstract: Boolean;
  protected
    //Calculates and saves if the class is abstract.
    procedure CalculateIsAbstract;


    //Copies all data of this identifier to the Clone.
    procedure CloneTo(Clone: TIdentifier); override;
  public
    //Creates the object and all lists.
    constructor Create; override;
    //Frees all lists and identifiers.
    destructor Destroy; override;


    //Calls Proc with each instance of TIdentType.
    procedure ForEachIdentType(Proc: TForEachIdentTypeProc; Parent: TIdentifier;
                               Data: TIdentifier = nil); override;
    //Adds the given set to its own and all contained identifiers.
    procedure AddPortabilityIssues(Portability: TIdentPortabilities); override;
    //Tests if it is or contains Ident.
    function RecursiveIsIn(Ident: TIdentifier): Boolean; override;

    //Gets a description of the identifier, mostly like it has been declared in
    //the pascal data.
    function GetDescriptionString(TextFormat: TTextFormat;
                                  SourceIdent: TIdentifier = nil): String;
                                                                      override;
    //Gets the declaration of the identifier in an internal representation.
    procedure GetDeclaration(Assembly: TDeclarationAssembler); override;

    //Generates a cross reference, by adding each identifier to each
    //identifier's ~[link UsedByIdents]-list it's using.
    function GenerateCrossReference: TIdentifier; override;

    //Tests if this identifier is equal to Other as regards content.
    function ParamEqualTo(Other: TType): Boolean; override;


    //Returns the parent/base class of the class or nil.
    function GetParent: TRecordType;


    //Gets the default property of this record-like type.
    function GetDefaultProperty: TProperty;


    //Finds an identifier in this record-like type or its ancestors.
    function FindMember(const MemberName: String; FromFile: TPascalFile;
                        IsOrHasInherited: Boolean): TIdentifier;







    //Adds itself and all owned identifiers to the list.
    procedure AddToList(List: TIdentifierList); override;
    //Saves the identifier to the stream.
    procedure Save(Stream: TIdentStream); override;
    //Loads the identifier from the stream.
    procedure Load(Stream: TIdentStream; Version: TIdentClassVersion);
                                                                      override;
    //Compares this identifier with the other one.
    function CompareWith(Ident: TIdentifier; const MsgPrefix: String;
                         Messages: TStrings): Boolean; override;





    property IdentList: TIdentifierList read FIdentList;
    property Kind: TRecordKind read FKind write FKind;
    property IdentParent: TIdentType read FParent write FParent;
    property GUID: String read FGUID write FGUID;
    property Implementing: TIdentifierList read FImplementing;
    property Children: TIdentifierList read FChildren;
    property VariantCases: TRecordCase read FVariantCases write FVariantCases;

    property StartsWithoutScope: Boolean read FStartsWithoutScope
                                         write FStartsWithoutScope;
    property IsAbstract: Boolean read FIsAbstract;
  end;






   { * * *  ***  * * *  ***   TProperty   ***  * * *  ***  * * *  }

  //possibilities to access properties of dispatch interfaces
  TDispatchInterfacePropertyAccessPossibilities = (
                           //full access to the property; read and write access
                           dipapFull,
                           //only read access
                           dipapReadOnly,
                           //only write access
                           dipapWriteOnly);

  {The class for all properties. Besides the type only the attributes to read
   and write the value and if it is the default property are saved. }
  TProperty = class(TIdentifier)
  private
    //indices if it is an array property
    FIndices: TIdentifierList;
    //the type of the property
    FPropertyType: TType;
    //the identifier to read the property/add event handlers
    FReadDef: String;
    //the identifier to write the property/remove event handlers
    FWriteDef: String;
    //whether it is a multicast event-handler
    FMultiCast: Boolean;
    //the implemented (redirected) interfaces by this property
    FImplementsInterfaces: String;
    //access index of the property
    FIndex: String;
    //whether nodefault or default given
    FDefaultDefined: Boolean;
    //expression after default (or '' if nodefault)
    FDefault: String;
    //expression of the directive stored
    FStored: String;
    //possibilities to access the property if it is in a dispatch interface
    FAccess: TDispatchInterfacePropertyAccessPossibilities;
    //DispIP of the property
    FDispID: String;
    //whether it is the default property
    FIsDefaultProp: Boolean;

  protected
    //Copies all data of this identifier to the Clone.
    procedure CloneTo(Clone: TIdentifier); override;
  public
    //Creates the object and the list for the array indices.
    constructor Create; override;
    //Frees also the type.
    destructor Destroy; override;


    //Calls Proc with each instance of TIdentType.
    procedure ForEachIdentType(Proc: TForEachIdentTypeProc; Parent: TIdentifier;
                               Data: TIdentifier = nil); override;
    //Adds the given set to its own and all contained identifiers.
    procedure AddPortabilityIssues(Portability: TIdentPortabilities); override;
    //Tests if it is or contains Ident.
    function RecursiveIsIn(Ident: TIdentifier): Boolean; override;

    //Gets a description of the identifier, mostly like it has been declared in
    //the pascal data.
    function GetDescriptionString(TextFormat: TTextFormat;
                                  SourceIdent: TIdentifier = nil): String;
                                                                      override;
    //Gets the declaration of the identifier in an internal representation.
    procedure GetDeclaration(Assembly: TDeclarationAssembler); override;


    //Adds itself and all owned identifiers to the list.
    procedure AddToList(List: TIdentifierList); override;
    //Saves the identifier to the stream.
    procedure Save(Stream: TIdentStream); override;
    //Loads the identifier from the stream.
    procedure Load(Stream: TIdentStream; Version: TIdentClassVersion);
                                                                      override;
    //Compares this identifier with the other one.
    function CompareWith(Ident: TIdentifier; const MsgPrefix: String;
                         Messages: TStrings): Boolean; override;



    //Returns if the property can only be read.
    function IsReadOnly: Boolean;



    property Indices: TIdentifierList read FIndices;
    property PropertyType: TType read FPropertyType write FPropertyType;
    property ReadDef: String read FReadDef write FReadDef;
    property WriteDef: String read FWriteDef write FWriteDef;
    property MultiCast: Boolean read FMultiCast write FMultiCast;
    property ImplementsInterfaces: String read FImplementsInterfaces
                                          write FImplementsInterfaces;
    property Index: String read FIndex write FIndex;
    property DefaultDefined: Boolean read FDefaultDefined
                                     write FDefaultDefined;
    property Default: String read FDefault write FDefault;
    property Stored: String read FStored write FStored;
    property Access: TDispatchInterfacePropertyAccessPossibilities read FAccess
                                                                 write FAccess;
    property DispID: String read FDispID write FDispID;
    property IsDefaultProp: Boolean read FIsDefaultProp write FIsDefaultProp;
  end;

















   { * * *  ***  * * *  ***   TIdentStream   ***  * * *  ***  * * *  }

  //The type of objects in a TStrings-List to write and load.
  TListObjectWriteType = (
                          lowtNone,     //don't save object
                          lowtInteger,  //save as (compressed) integer
                          lowtFile);    //save as file r