ufileparser.pas

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

~param UsesStr  the remnant of the statement after uses/contains
~param UnitList the list in which all units should be added, a reference to
                the parser object will also be stored with the
                objects-property }
procedure TFileParser.ParseUnitList(const UsesStr: String; UnitList: TStrings);

 {Searches the used unit by its name.
 ~param FileName the name of the file of the unit, if specified
 ~param UnitName the name of the unit
 ~result the object representing the unit or nil }
 function FindUnit(const FileName, UnitName: String): TPascalFile;
 var      i       :Integer;              //index of the unit
 begin
  Result := nil;                         //file not found yet
  if FileName = '' then                  //no "in"-clause (i.e. this is a unit)
   begin
    if Assigned(FThisFile.ProjectFile) then //project known?
     begin                                   //if unit is in project use it
      i := FThisFile.ProjectFile.UsedUnitList[fpMain].IndexOf(UnitName);
      if i <> -1 then
       Result := TPascalFile(FThisFile.ProjectFile.UsedUnitList[fpMain].
                                                                    Objects[i])
      else
       begin
        i := FThisFile.ProjectFile.UsedUnitList[fpInterface].IndexOf(UnitName);
        if i <> -1 then
         Result := TPascalFile(FThisFile.ProjectFile.UsedUnitList[fpInterface].
                                                                   Objects[i]);
       end;
      //if unit in same directory as the project file use it
      if not Assigned(Result) then
       Result := FThisFile.FileList.GetFileAbsolute(
                          ExtractShortPathName(ExpandFileName(
                              ExtractFilePath(FThisFile.ProjectFile.FilePath) +
                              UnitName + '.pas')));
     end
    else
     //search unit in the same directory (through absolute unique path)
     Result := FThisFile.FileList.GetFileAbsolute(ExtractShortPathName(
                           ExpandFileName(ExtractFilePath(FThisFile.FilePath) +
                                          UnitName + '.pas')));
   end;

  if not Assigned(Result) then               //not found that way?
   //search just by the name
   Result := FThisFile.FileList.GetFileByName(UnitName);

  if not Assigned(Result) and                //not parsed so far?
     (FThisFile.FileList.ParserManager is TParserManager) then
   //ask the list of files to search for the unit
   Result := TParserManager(FThisFile.FileList.ParserManager).UnknownUnit(Self,
                                                                     UnitName);
 end;

var       Parser     :TTokenParser;       //parses the uses/contains-string
          UnitName   :String;             //name of the used/contained unit
          FileName   :String;             //name of the file of a unit
          Token      :String;             //a token in the string
          i          :Integer;            //general index
          TheUnit    :TPascalFile;        //the object representing the unit
begin
 Assert(UnitList.Count = 0);

 Parser := TTokenParser.Create;           //create parser
 try
   Parser.ParseString(UsesStr);           //and parse the uses/contains-string
   while Parser.GetIdentWithPointsToken(UnitName) do //read all units
    begin
     FileName := '';
     if Parser.GetToken(Token) then         //read next token ("," or "in")
      if LowerCase(Token) = 'in' then         //name of file given?
       begin                                    //read name of file
        if not Parser.GetToken(FileName) or (Length(FileName) < 3) or
           (FileName[1] <> '''') or (FileName[Length(FileName)] <> '''') then
         Exception(etSyntax,
                   '"''Path\To\Unit.pas''" expected in uses-clause after "in"!');

        if Parser.GetToken(Token) and (Token <> ',') then  //read ","
         Exception(etSyntax,
                   '"," after "in" and path to unit-file expected in uses-clause!');

        //extract name of file out of the string
        FileName := Copy(FileName, 2, Length(FileName) - 2);
        i := pos('''''', FileName);     //change all "''" to "'"
        while i <> 0 do
         begin
          Delete(FileName, i, 1);
          i := SearchString('''''', FileName, i + 1);
         end;
       end
      else
       begin
        if Token <> ',' then
         Exception(etSyntax, '"," or "in" expected in uses-clause!');

        //check for unit-aliases
        UnitName := FThisFile.GetUnitAlias(UnitName);
       end
      else
       //check for unit-aliases
       UnitName := FThisFile.GetUnitAlias(UnitName);

     TheUnit := FindUnit(FileName, UnitName);        //search the unit
     if Assigned(TheUnit) then                       //unit has been parsed?
      UnitList.AddObject(UnitName, TheUnit)            //add used unit
     else
      FThisFile.UnknownUnits.Add(UnitName);            //add unknown unit
    end;
 finally
  Parser.Free;                            //free the parser
 end;
end;


{Parses the list of used/contained units in the first uses clause. }
procedure TFileParser.ParseInterfaceUsedUnits;
begin
 //check if correct state of parsing
 DoCheckParseState(psInterfaceUsesClauseParsed);

 ParseUnitList(FThisFile.UsesClauses[fpInterface],
               FThisFile.UsedUnitList[fpInterface]); //uses in interface

 //initialize the number of references to the used units
 SetLength(FUnitUsage[fpInterface], FThisFile.UsedUnitList[fpInterface].Count);
 FillChar(FUnitUsage[fpInterface][0],
          Length(FUnitUsage[fpInterface]) * SizeOf(FUnitUsage[fpInterface][0]),
          0);

 ParseState := psInterfaceUnitsParsed;     //set new state of parsing
end;

{In case it is a unit, all identifiers in the interface are checked. Then the
 used untis of the implementation part is parsed (also for not-units). }
procedure TFileParser.LinkUnitInterfaceAndParseImplementationUsedUnits;
begin
 DoCheckParseState(psInterfaceParsed);      //check if correct state of parsing

 if FThisFile.FileType = sftUnit then       //if it is a unit
  LinkInterfaceIdentTypes;                    //link interface types
 //uses/contains elsewhere
 ParseUnitList(FThisFile.UsesClauses[fpMain], FThisFile.UsedUnitList[fpMain]);

 //initialize the number of references to the used units
 SetLength(FUnitUsage[fpMain], FThisFile.UsedUnitList[fpMain].Count);
 FillChar(FUnitUsage[fpMain][0],
          Length(FUnitUsage[fpMain]) * SizeOf(FUnitUsage[fpMain][0]), 0);

 ParseState := psImplementationUnitsParsed; //set new state of parsing
end;





{Links all record-like types (classes and interfaces) correctly together after
 parsing the interfaces of all units. The hierarchy of these identifiers has to
 be set correctly before calling this method (i.e. the parent set). This means
 all classes have to have a reference to their parent-classes. The types of
 inherited properties will also be determined. }
procedure TFileParser.ConsistencyAfterRecordHierarchy;
var       i          :Integer;      //counter through all identifiers (classes)
          Ident      :TIdentifier;  //the identifiers in this file
          j          :Integer;      //counter through all members of ident
          Member     :TIdentifier;  //the members of ident
begin
 Assert((FActualIdents = FThisFile.Idents) or not Assigned(FActualIdents));

 //check if correct state of parsing
 DoCheckParseState(psImplementationUnitsParsed);

 for i := 0 to FThisFile.Idents.Count - 1 do //for each identifier in the file
  begin
   Ident := FThisFile.Idents[i];      //get it
   if Ident is TRecordType then       //if it is a record-like type
    begin
     for j := 0 to TRecordType(Ident).IdentList.Count - 1 do //for each member
      begin
       Member := TRecordType(Ident).IdentList[j];         //get the member

       if (Member is TProperty) and             //if it is a property without
          not Assigned(TProperty(Member).PropertyType) then //a known type
        FindPropertyType(TProperty(Member));                  //search its type

       //test if another record-like type is used
       if (Member is TProperty) or (Member is TField) then
        Member.ForEachIdentType(CallBackSetClassUsing, nil, Ident);
      end;

     Member := TRecordType(Ident).GetParent;
     if Assigned(Member) then        //if this type has a known parent-class
      begin
       Assert(not TRecordType(Member).Children.IsIn(Ident));
       //add/register this type as a child to its parent
       TRecordType(Member).Children.AddIdent(Ident);
      end;
    end;
  end;

 ParseState := psInterfaceClassHierarchyChecked; //set new state of parsing
end;

{Sorts the different lists of identifiers after parsing the whole file. }
procedure TFileParser.ConsistencyAfterParse;

 procedure AddUnusedUnitsHints(Manager: TParserManager);
 var       Information        :TParseMessageInformation;  //information of hint

  {Checks the reference counter for each unit whether it has been used.
  ~param Part the part of the file in which the unit is used }
  procedure CheckUnits(Part: TFilePart);
  var       i         :Integer;         //counter through the used units
  begin
   for i := 0 to Length(FUnitUsage[Part]) - 1 do  //for each used unit
    if FUnitUsage[Part][i] = 0 then                 //is never used?
    begin
{                                         //set the message text
     Information.Message := Format('File %s uses %s exactly %d times',
                                   [FThisFile.InternalFileName,
                                    FThisFile.UsedUnitList[Part][i],
                                    FUnitUsage[Part][i]]);
}

                                         //set the message text
     Information.Message := Format('File %s never uses used unit %s.',
                                   [FThisFile.InternalFileName,
                                    FThisFile.UsedUnitList[Part][i]]);
     Manager.HandleMessage(Information, Self);        //add the hint message
    end;
  end;

 begin
  Information.MessageKind := pmkHint;         //initialize the hint
  Information.MessageType := etNone;
  Information.TheFile := FThisFile;
  Information.EffectiveFile := FThisFile;

  //uses clause of interface is roughly at the beginning of the file
  Information.ErrorPosition.Row := 1;
  Information.ErrorPosition.Column := 1;
  Information.EffectiveErrorPosition := Information.ErrorPosition;

  CheckUnits(fpInterface);                    //check units used in interface

  //uses clause of the main part is directly below the start of implementation
  Information.ErrorPosition := FThisFile.ImplementationStart;
  Information.EffectiveErrorPosition := Information.ErrorPosition;

  CheckUnits(fpMain);                         //check units used in main part
 end;


var       i          :Integer;           //counter through the identifiers
          Ident      :TIdentifier;       //the identifiers
begin
 DoCheckParseState(psImplementationParsed); //check if correct state of parsing

 for i := 0 to FThisFile.Idents.Count - 1 do //for each identifier in the file
  begin
   Ident := FThisFile.Idents[i];           //get it
   if Ident is TRecordType then            //is it a record-like type?
    begin
     TRecordType(Ident).Children.Sort;       //sort the list of its children
     if TRecordType(Ident).Kind = rkInterface then //if it is an interface
      TRecordType(Ident).Implementing.Sort;    //sort its implementing classes
    end;
  end;


 //message-list for hints available?
 if Assigned(FThisFile.FileList) and
    (FThisFile.FileList.ParserManager is TParserManager) then
  //add the hints about used units that are not referenced
  AddUnusedUnitsHints(TParserManager(FThisFile.FileList.ParserManager));


 ParseState := psFinalConsistency; //set new state of parsing
end;




{Increments the reference counter for the used unit.
~param Part  the part of the file in which the unit is used
~param Index the index of unit in the order of the uses clause }
procedure TFileParser.CountUnitReference(Part: TFilePart; Index: Integer);
begin
 Assert(Index >= 0);
 Assert(Index < Length(FUnitUsage[Part]));

 Inc(FUnitUsage[Part][Index]);        //increment the counter
end;




initialization

 //create list for in Delphi predefined identifiers
 PreDefinedIdents := TStringList.Create;
 PreDefinedIdents.Duplicates := dupIgnore;
 PreDefinedIdents.Sorted := True;

 //create list for in unit System internally defined identifiers of types
 SystemTypes := TStringList.Create;
 SystemTypes.Duplicates := dupIgnore;
 SystemTypes.Sorted := True;

 //create list for in unit System internally defined identifiers
 SystemIdents := TStringList.Create;
 SystemIdents.Duplicates := dupIgnore;
 SystemIdents.Sorted := True;


finalization

 //free the above created lists
 SystemIdents.Free;
 SystemTypes.Free;
 PreDefinedIdents.Free;

end.