ufileparser.pas

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

   end; //if not assigned(TheType)

  if Assigned(TheType) then               //declaration of identifier found?
   begin
    if not (TheType is TType) then          //identifier is a type?
     ExceptionIdentFmt(Data, etSyntax,
                       'Found identifier of the type is not a type-identifier: "%s"!',
                       [Ident.DefIdent]);

    Ident.TheType := TType(TheType);        //save this identifier
   end
  else
   AddToUnknownTypeIdents(Ident.DefIdent);  //type-identifier is unknown!
 end;

 {Searches the type in the given used unit.
 ~param UnitName the name of the unit containing the type
 ~param TypeName the name of the type }
 procedure SearchInUsedUnit(const UnitName, TypeName: String);
 var       Index           :Integer;     //counter through all used units
           TheFile         :TPascalFile; //file containing the identifier
           TheType         :TIdentifier; //the searched type
 begin
  //it's this/the same file?
  if LowerCase(UnitName) = LowerCase(FThisFile.InternalFileName) then
   TheFile := FThisFile
  else
   begin                                 //search used units for that unit
    Index := FThisFile.UsedUnitList[fpInterface].IndexOf(UnitName);
    if Index <> -1 then
     begin
      TheFile := TPascalFile(FThisFile.UsedUnitList[fpInterface].
                                                               Objects[Index]);
      Inc(FUnitUsage[fpInterface][Index]); //count reference
     end
    else
     TheFile := nil;
   end;


  if Assigned(TheFile) then              //file found?
   begin                                   //search the identifier in it
    TheType := TheFile.Idents.GetIdentByName(TypeName);
    if Assigned(TheType) then              //identifier found?
     if TheFile = FThisFile then             //declared in the same file?
      begin                                    //declared before identifier?
       if (TheType.ForwardDefPos.Row > Data.Position.Row) or
          ((TheType.ForwardDefPos.Row = Data.Position.Row) and
           (TheType.ForwardDefPos.Column > Data.Position.Column)) then
        TheType := nil;
      end
     else
      if TheType.Scope <> sInterface then      //not declared in interface?
       TheType := nil;

    if not Assigned(TheType) then          //valid identifier found?
     ExceptionIdentFmt(Data, etSyntax,
                       'Type-identifier in unit not found: "%s"!',
                       [Ident.DefIdent]);
    if not (TheType is TType) then         //is type-identifier?
     ExceptionIdentFmt(Data, etSyntax,
                       'Found identifier in unit is not a type: "%s"!',
                       [Ident.DefIdent]);


    Ident.TheType := TType(TheType);       //save this identifier
   end //if assigned(TheFile)
  else
   begin                                   //unit is used?
    if FThisFile.UnknownUnits.IndexOf(UnitName) = -1 then
     ExceptionIdentFmt(Data, etSyntax,
                       'Type-identifier with unknown unit: "%s"!',
                       [Ident.DefIdent]);

    //identifier is unknown (because unit is unknown)
    AddToUnknownTypeIdents(TypeName, UnitName);
   end; //else assigned(TheFile)
 end;


var       Dot        :Integer;     //index of the '.' in the identifier-string
begin
 Assert(Assigned(Data));
 if not Assigned(Ident.TheType) then //not already linked?
  begin
   Dot := Pos('.', Ident.DefIdent);
   if Dot = 0 then                     //unit of type not given?
    SearchInSameUnit                     //search the type
   else
    SearchInUsedUnit(Copy(Ident.DefIdent, 1, Dot - 1),    //search the type in
                     Copy(Ident.DefIdent, Dot + 1,         //that unit
                          High(Length(Ident.DefIdent))));
  end;
end;


{Links all identifiers of the interface-section of units. The type of the
 identifiers will be searched and the references saved. }
procedure TFileParser.LinkInterfaceIdentTypes;
var       i          :Integer;     //counter through the identifiers
          Ident      :TIdentifier; //the identifiers
begin
 Assert(FActualIdents = FThisFile.Idents);
 for i := 0 to FActualIdents.Count - 1 do //for each identifier
  begin
   Ident := FActualIdents[i];        //get it and check its type-identifiers
   Ident.ForEachIdentType(CallBackIdentTypeInterface, nil, Ident);
  end;
end;



{Will be called for each ~[linkClass TIdentType] in all fields and properties.
 If it references another record-like type the record-like type of the
 field/property will be added as using the other.
~param Ident  each of the identifiers from the class TIdentType
~param Parent the identifier that directly contains Ident
~param Data   application data; the record-like type identifier}
procedure TFileParser.CallBackSetClassUsing(Ident: TIdentType;
                                            Parent: TIdentifier;
                                            Data: TIdentifier);
begin
 Assert(Assigned(Data) and (Data is TRecordType));
 if (Ident.TheType is TRecordType) and     //contains a record-like type?
    not TRecordType(Ident.TheType).UsedByIdents.IsIn(Data) then
  //add main record-like identifier
  TRecordType(Ident.TheType).UsedByIdents.AddIdent(Data);
end;



















{Will be called before parsing the interface of a unit. If it is the unit
 System the predefined identifiers will be added. }
procedure TFileParser.PreParseThisUnit;
var       i, Index   :Integer;
          S          :String;
          AType      :TType;
          AVariable  :TVariable;
begin
 //it is the unit System?
 if LowerCase(FThisFile.InternalFileName) = 'system' then
  begin
   for i := 0 to SystemTypes.Count - 1 do //for each predefined type
    begin
     S := SystemTypes[i];

     Index := pos('=', S);
     if Index <> 0 then                     //type not defined?
      Delete(S, Index, high(length(S)));
     S := Trim(S);

{     Index := pos('=', S);
     if Index = 0 then                      //type not defined?
      begin
}       AType := TIdentType.Create;
       try
         AType.Scope := sInterface;
         AType.Name := S;
         TIdentType(AType).DefIdent := S;
         AType.InFile := FThisFile;
         AType.EffectiveFile := FThisFile;
         AType.EffectiveForwardFile := FThisFile;
         FThisFile.Idents.AddIdent(AType);    //add identifier for this type
       except
         AType.Free;
         raise;
       end;
{      end
     else
      begin                                   //parse definition of the type
       AType := ParseStringToType(Trim(copy(S, Index + 1, high(length(S)))));
       try
         AType.Scope := sInterface;
         AType.Name := Trim(copy(S, 1, Index - 1));
         Idents.AddIdent(AType);              //add identifier for this type
       except
         AType.Free;
         raise;
       end;
      end;
}    end;

   for i := 0 to SystemIdents.Count - 1 do //for each predefined identifier
    begin
     AVariable := TVariable.Create;
     try
       AVariable.Scope := sInterface;
       AVariable.Name := SystemIdents[i];
       AVariable.VarType := TIdentType.Create;
       TIdentType(AVariable.VarType).DefIdent := 'Integer';
       AVariable.InFile := FThisFile;
       AVariable.EffectiveFile := FThisFile;
       AVariable.EffectiveForwardFile := FThisFile;
       FThisFile.Idents.AddIdent(AVariable);      //add as an Integer-Variable
     except
       AVariable.Free;
       raise;
     end;
    end;
  end;
end;















{Adds the identifier to the list of unknown type identifiers of the file.
~param IdentName the unknown identifier of a type
~param UnitName  the unit in which it has been defined (if given) }
procedure TFileParser.AddToUnknownTypeIdents(IdentName: String;
                                             const UnitName: String = '');
begin
 if PreDefinedIdents.IndexOf(IdentName) = -1 then   //not already in list
  begin
   if UnitName <> '' then                             //if name of unit given
    IdentName := UnitName + '.' + IdentName;            //prepend it
   FThisFile.UnknownTypeIdents.Append(IdentName);     //add the identifier
  end;
end;

{Adds the identifier to the list of unknown identifiers of the file.
~param IdentName the unknown identifier
~param Pre       text to be prepended before the name of identifier
~param Post      text to be appended after the name of identifier }
procedure TFileParser.AddToUnknownIdents(const IdentName: String;
                                         const Pre: String = '';
                                         const Post: String = '');
var       Position   :TPosition;
begin
 //not already in list and not an (unknown) used unit
 if (PreDefinedIdents.IndexOf(IdentName) = -1) and
    (FThisFile.UnknownUnits.IndexOf(IdentName) = -1) then
  begin
   Position := AbsoluteLastTokenStartPos;
   FThisFile.UnknownIdents.AddObject(Pre + IdentName + Post,   //add identifier
                                     TObject(Pointer(Position.Row or
                                                     Position.Column shl 22)));
  end;
end;






{Finds the type of a property that was redefined (to change the scope). If
 a property is redefined (f.i. to put it in another scope) in an sub-class, the
 type is omited. This function searches the property in the base-classes and
 sets the type of the property to the type of that property.
~param Prop the property whose type schould be searched }
procedure TFileParser.FindPropertyType(Prop: TProperty);
var       Rec        :TRecordType;        //base-class(es) of the property
          Ident      :TIdentifier;        //identifier (property) in base-class
begin
 Rec := Prop.MemberOf.GetParent;          //get parent of class
 Ident := nil;                            //no inherited property found so far
 while Assigned(Rec) and not Assigned(Ident) do
  begin
   Ident := Rec.IdentList.GetIdentByName(Prop.Name); //search ident by its name

   //identifier not visible to this class?
   if Assigned(Ident) and
      (Ident.InFile <> FThisFile) and (Ident.Scope = sPrivate) then
    Ident := nil;

   if Assigned(Ident) then                     //identifier in parent found?
    begin
     if not (Ident is TProperty) then
      ExceptionIdentFmt(Prop, etSyntax,
                        'Property "%s" has no type, but inherited identifier is no property!',
                        [Prop.Name]);
     //if the property has also no type, search again
     if not Assigned(TProperty(Ident).PropertyType) then
      Ident := nil;
    end;

   if not Assigned(Ident) then                 //no property with type found?
    Rec := Rec.GetParent;                      //get (next) parent class
  end;

 if Assigned(Ident) then                  //inherited property with type found?
  begin
   Assert(Ident is TProperty);
   Assert(Assigned(TProperty(Ident).PropertyType));
   //clone the type and set it as the type of the property
   Prop.PropertyType := TType(TProperty(Ident).PropertyType.Clone);
   //copy relevant attributes
   Prop.MultiCast := TProperty(Ident).MultiCast;
  end;
end;




{Parses a uses/contains-string to a list of the units. All not parsed units
 will be added to
 ~[link FThisFile].~[link TPascalFile.UnknownUnits UnknownUnits].