uextidents.pas

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

    //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;


    property FieldType: TType read FFieldType write FFieldType;
  end;






   { * * *  ***  * * *  ***   TGoToLabel  ***  * * *  ***  * * *  }


  {The class for labels to jump to with a goto-statement. }
  TGoToLabel = class(TIdentifier)
  private
  protected
  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;
  end;







   { * * *  ***  * * *  ***   TExportIdentifier  ***  * * *  ***  * * *  }


  {The class for identifiers in exports-statements. The only valid inherited
   fields are ~[link Name], ~[link Position] and ~[link ForwardDefPos]. The
   positions are the same and name holds the declaration of the exported
   identifier, i.e. a simple identifier or a file and and identifier separated
   by a dot. }
  TExportIdentifier = class(TIdentifier)
  private
    //the declaration of the index to export the identifier with
    FExportIndex: String;
    //the declaration of the name to export the identifier with
    FExportName: String;
    //if the obsolete and ignored directive "resident" has been defined
    FResident: Boolean;
  protected
    //Copies all data of this identifier to the Clone.
    procedure CloneTo(Clone: TIdentifier); override;

    //Returns the list containing this identifier.
    function GetParentList: TIdentifierList; 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;

    //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 ExportIndex: String read FExportIndex write FExportIndex;
    property ExportName: String read FExportName write FExportName;
    property Resident: Boolean read FResident write FResident;
  end;








//all known classes of identifiers; needed for loading and saving the data
const AllIdentClasses: array[0..25] of TIdentifierClass = (
             TIdentifier,            TType,                TIdentType,
             TPackableType,          TRecordType,          TProperty,
             TArrayType,             TClassReferenceType,  TConstant,
             TEnumType,              TEnumTypeItem,        TExportIdentifier,
             TField,                 TFileType,            TFunction,
             TFunctionType,          TGoToLabel,           TParameter,
             TPointerType,           TProgramMainFunction, TResourceString,
             TSetType,               TStringType,          TSubRangeType,
             TUnitInitFinalFunction, TVariable);



      //the classes for the different kinds of members of classes
      MemberKindClasses: array[TMemberKind] of TIdentifierClass =
                         (TField, TProperty, TFunction);






implementation












   { * * *  ***  * * *  ***   TVariable   ***  * * *  ***  * * *  }



{Frees the identifier and its type object. }
destructor TVariable.Destroy;
begin
 FVarType.Free;                    //free the type

 inherited Destroy;                //free the object
end;

{Copies all data of this identifier to the Clone.
~param Clone the identifier that should receive all data of this object }
procedure TVariable.CloneTo(Clone: TIdentifier);
begin
 inherited CloneTo(Clone);                           //copy inherited values

 TVariable(Clone).VarType := TType(FVarType.Clone);  //clone the type
 TVariable(Clone).VarInitialization := FInitialization; //and copy the other
 TVariable(Clone).IsThreadVar := FIsThreadVar;            //values
{
 TVariable(Clone).External := FExternal;
 TVariable(Clone).ExternalName := FExternalName;
 TVariable(Clone).ExternalDLLName := FExternalDLLName;
} 
end;


{Calls Proc with each instance of ~[linkClass TIdentType].
~param Proc   the call back-procedure to be called by each object of the class
              TIdentType
~param Parent the direct parent of this identifier, will be a parameter to the
              call back-procedure if this is an object of the class TIdentType
~param Data   data to pass on to the call back-procedure when calling }
procedure TVariable.ForEachIdentType(Proc: TForEachIdentTypeProc;
                                     Parent: TIdentifier;
                                     Data: TIdentifier = nil);
begin
 FVarType.ForEachIdentType(Proc, Self, Data);   //test with the type
end;

{Adds the given set of portability issues to its own and all contained
 identifiers.
~param Portability the portability issues to add }
procedure TVariable.AddPortabilityIssues(Portability: TIdentPortabilities);
begin
 inherited AddPortabilityIssues(Portability);         //add portability issues
 FVarType.AddPortabilityIssues(SummarizedPortability);  //add also to type
end;

{Tests if this object is or contains Ident.
~param Ident the identifier for which should be tested, if it is or is
             contained by this object
~result if the identifier is this object or is contained by it }
function TVariable.RecursiveIsIn(Ident: TIdentifier): Boolean;
begin                //identifier is this variable or the type?
 Result := inherited RecursiveIsIn(Ident) or
           FVarType.RecursiveIsIn(Ident);
end;

{Gets a description of the identifier, mostly like it has been declared in the
 pascal data.
~param TextFormat  an object as a set of call back-functions to format text
~param SourceIdent the ident for which the whole description should be
                   generated
~result the description of the identifier formatted by TextFormat }
function TVariable.GetDescriptionString(TextFormat: TTextFormat;
                                        SourceIdent: TIdentifier = nil): String;
{
         //directives of variables in FreePascal
const    Directives: array[Succ(Low(FExternal))..High(FExternal)] of String =
                     ('external', 'export', 'public', 'cvar');
}
begin
 if not assigned(SourceIdent) then
  SourceIdent := Self;
 assert(assigned(SourceIdent.InFile));

 Result := TextFormat.IdentifierText(Name) + ': ' + //return the name and type
           FVarType.GetDescriptionString(TextFormat, SourceIdent);
 if FInitialization <> '' then  //if initialized append that, too
  begin
   if FVarInitIsAbsolute then
    Result := Result + ' ' + TextFormat.ReservedWord('absolute') + ' '
   else
    Result := Result + ' = ';
   Result := Result + TextFormat.ExprText(FInitialization, SourceIdent)
  end;

{
 if FExternal <> veNone then            //directive spezified?
  begin
   //add the directives including attributes
   Result := Result + '; ' + TextFormat.ReservedWord(Directives[FExternal]);
   if FExternalDLLName <> '' then
    Result := Result + ' ' +
                       TextFormat.ExprText(FExternalDLLName, SourceIdent);
   if FExternalName <> '' then
    Result := Result + ' ' + TextFormat.ReservedWord('name') + ' ' +
                       TextFormat.ExprText(FExternalName, SourceIdent);
  end
 else
  begin
   assert(FExternalName = '');
   assert(FExternalDLLName = '');
  end;
}

// if FIsThreadVar then
//  Result := Result + ' (thread)';
end;


{Gets the declaration of the identifier in an internal representation.
~param Assembly an object with a set of call back-functions to save the
                 declaration }
procedure TVariable.GetDeclaration(Assembly: TDeclarationAssembler);
begin
 Assembly.IdentifierText(Name);      //add the name and type
 Assembly.Text(': ');
 FVarType.GetDeclaration(Assembly);
 if FInitialization <> '' then        //if initialized append that, too
  begin
   if FVarInitIsAbsolute then           //is initialized as being an alias to
    begin                                //another variable?
     Assembly.Text(' ');
     Assembly.ReservedWord('absolute');  //add "absolute"
     Assembly.Text(' ');
    end
   else
    Assembly.Text(' = ');                //add the equal sign
   Assembly.ExprText(FInitialization); //add the initialization
  end;
end;



{Adds itself and all owned identifiers to the list.
~param List the list to add the identifiers to }
procedure TVariable.AddToList(List: TIdentifierList);
begin
 inherited AddToList(List);                 //add itself

 FVarType.AddToList(List);                  //and its type
end;


{Saves the identifier to the stream.
~param Stream the stream to save itself to }
procedure TVariable.Save(Stream: TIdentStream);
begin
 inherited Save(Stream);                   //write inherited data

 Stream.WriteIdent(FVarType);              //write data
 Stream.WriteString(FInitialization);
 Stream.WriteBoolean(FVarInitIsAbsolute);
 Stream.WriteBoolean(FIsThreadVar);
end;

{Loads the identifier from the stream.
~param Stream  the stream to load the identifier from
~param Version the version the data of the identifier is in }
procedure TVariable.Load(Stream: TIdentStream; Version: TIdentClassVersion);
begin
 inherited Load(Stream, Version);                         //load inherited data

 FVarType := TType(Stream.ReadIdentClass(TType, True));   //read data
 FInitialization := Stream.ReadString;
 FVarInitIsAbsolute := Stream.ReadBoolean;
 FIsThreadVar := Stream.ReadBoolean;
end;


{Compares this identifier with the other one.
~param Ident     the identifier to compare this one with
~param MsgPrefix prefix for the messages to be generated
~param Messages  describing messages are added to this list, if the identifiers
                 are not equal
~result if the identifiers are equal }
function TVariable.CompareWith(Ident: TIdentifier; const MsgPrefix: String;