ufileparser.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc 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, see <http://www.gnu.org/licenses/>.
}


unit UFileParser;

{Contains the class ~[linkClass TFileParser] to parse pascal data as a real
 pascal file in connection with other files and for that reason also the class
 ~[linkClass TFileList] is defined to manage a list of this pascal files.
}

interface

uses Classes,
     UBaseIdents, UExtIdents,
     UTokenParser, USingleFileParser;

type



   { * * *  ***  * * *  ***   TFileParser   ***  * * *  ***  * * *  }


  {Extends its base class to parse the pascal data in files linked with other
   files. All identifiers get linked to each other if they reference the same
   identifiers logically, for instance a class gets a link on its parent class.
   Several event-methods are overridden to fulfill this requirement. If the
   file is the unit System the default identifiers are added to it. Lists of
   all unknown types and identifiers are maintained. }
  TFileParser = class(TSingleFileParser)
  private
    //Parses a uses/contains-string to a list of the units.
    procedure ParseUnitList(const UsesStr: String; UnitList: TStrings);

  protected
    //the number of references to the used units of the parsed file
    //~feature maybe move the reference count into the ~[link TPascalFile file]
    //         itself
    FUnitUsage: array[TFilePart] of array of Integer;


    //Adds the identifier to the list of unknown type identifiers of the file.
    procedure AddToUnknownTypeIdents(IdentName: String;
                                     const UnitName: String = '');
    //Adds the identifier to the list of unknown identifiers of the file.
    procedure AddToUnknownIdents(const IdentName: String;
                                 const Pre: String = '';
                                 const Post: String = '');


    //Finds the type of a property that was redefined (to change the scope).
    procedure FindPropertyType(Prop: TProperty);



    //Will be called for each ~[linkClass TIdentType] in the interface-section
    //of all units. The type of the identifier will be searched and saved.
    procedure CallBackIdentTypeInterface(Ident: TIdentType; Parent: TIdentifier;
                                         Data: TIdentifier);
    //Links all identifiers of the interface-section of units.
    procedure LinkInterfaceIdentTypes;



    //Will be called for each TIdentType in all fields and properties and
    //checks if it references another record-like type.
    procedure CallBackSetClassUsing(Ident: TIdentType; Parent: TIdentifier;
                                    Data: TIdentifier);



    {Will be called for all ~[linkClass TIdentType] besides the in the
     interface-section of units. The type of the identifier should be searched
     and saved.
    ~param Ident  each of the identifiers from the class TIdentType
    ~param Parent the identifier that directly contains Ident
    ~param Data   application data; unused, will be nil }
    procedure CallBackAfterLocalDefinition(Ident: TIdentType;
                                           Parent: TIdentifier;
                                           Data: TIdentifier); virtual;
                                                               abstract;


    //Will be called before and after any function and at the end of the
    //section.
    procedure AfterDefinition(StartIndex: Integer); override;

    //Will be called after parsing the head of a function before parsing the
    //local definitions and the body.
    procedure BeforeFunctionLocalsAndBody(Func: TFunction); override;
    //Will be called inside a function before the body and before and after any
    //nested function.
    procedure AfterLocalDefinition(StartIndex: Integer);





    //Will be called before parsing the interface of a unit; if it is the
    //unit System it adds the predefined identifiers.
    procedure PreParseThisUnit; override;



  public

    //Returns the list of all in Delphi defined identifiers.
    class function GetPreDefinedIdentList: TStringList;
    //Returns the list of all internal type identifiers.
    class function GetSystemTypeList: TStringList;
    //Returns the list of all internal identifiers apart from type identifiers.
    class function GetSystemIdentList: TStringList;





    //Parses the list of used/contained units in the first uses clause.
    procedure ParseInterfaceUsedUnits;
    //In case it is a unit, all identifiers in the interface are checked.
    procedure LinkUnitInterfaceAndParseImplementationUsedUnits;

    //Links all record-like types (classes and interfaces) correctly together
    //after parsing the interfaces of all units.
    procedure ConsistencyAfterRecordHierarchy;
    //Sorts the different lists of identifiers.
    procedure ConsistencyAfterParse;


    //Increments the reference counter for the used unit.
    procedure CountUnitReference(Part: TFilePart; Index: Integer);
  end;





implementation

uses SysUtils,
     General, UFilePaths,
     UPascalConsts,
     UParse;


var   PreDefinedIdents: TStringList; //ignore this Identifiers, when unknown
      SystemTypes: TStringList;    //define these types, if parsing unit System
      SystemIdents: TStringList;   //define these identifiers, if unit System








   { * * *  ***  * * *  ***   TFileParser   ***  * * *  ***  * * *  }



{Returns the list of all in Delphi defined identifiers. The identifiers in this
 list won't be added to the list of unknown identifiers when encountered. It's
 empty on start-up and shared between all parsers.
~result the list of all in Delphi defined identifiers }
class function TFileParser.GetPreDefinedIdentList: TStringList;
begin
 Result := PreDefinedIdents;
end;

{Returns the list of all internal type identifiers. The identifiers will be
 created, when the unit System is parsed. It's empty on start-up and shared
 between all parsers.
~result the list of all internal type identifiers }
class function TFileParser.GetSystemTypeList: TStringList;
begin
 Result := SystemTypes;
end;

{Returns the list of all internal identifiers apart from type identifiers. The
 identifiers will be created, when the unit System is parsed. It's empty on
 start-up and shared between all parsers.
~result the list of all internal identifiers }
class function TFileParser.GetSystemIdentList: TStringList;
begin
 Result := SystemIdents;
end;













{Will be called before and after any function and at the end of the section.
~param Startindex index of the first new identifier since the last time this
                  function has been called }
procedure TFileParser.AfterDefinition(StartIndex: Integer);
var       i          :Integer;       //counter through the new identifiers
          Ident      :TIdentifier;   //the identifier
          j          :Integer;       //counter through the members
          Member     :TIdentifier;   //a member of the identifier
begin
 Assert(FActualIdents = FThisFile.Idents);
 for i := StartIndex to FActualIdents.Count - 1 do //for all new identifiers
  begin
   Ident := FActualIdents[i];          //get identifier
   //for all type-identifiers, try to link identifier references
   Ident.ForEachIdentType(CallBackAfterLocalDefinition, nil);

   if Ident is TRecordType then        //if it is a record-like type
    begin                                //for all members
     for j := 0 to TRecordType(Ident).IdentList.Count - 1 do
      begin
       Member := TRecordType(Ident).IdentList[j]; //get member

       if (Member is TProperty) and        //if it is a property without a type
          not Assigned(TProperty(Member).PropertyType) then
        FindPropertyType(TProperty(Member));  //try to find it

       //for properties and fields, test if type is another record-like, and in
       //that case add this type to the types that use it
       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 parent-class/-interface
      begin
       Assert(not TRecordType(Member).Children.IsIn(Ident));
       //add this type as a child to its parent
       TRecordType(Member).Children.AddIdent(Ident);
      end;
    end; //if Ident is TRecordType
  end; //for i := StartIndex to FActualIdents.Count - 1
end;

{Will be called after parsing the head of a function before parsing the local
 definitions and the body.
~param Func the function that is about to be parsed }
procedure TFileParser.BeforeFunctionLocalsAndBody(Func: TFunction);
begin
 //for all type-identifiers of the function-declaration, try to link identifier
 Func.ForEachIdentType(CallBackAfterLocalDefinition, nil);         //references
end;

{Will be called inside a function before the body and before and after any
 nested function.
~param Startindex index of the first new identifier since the last time this
                  function has been called }
procedure TFileParser.AfterLocalDefinition(StartIndex: Integer);
var       i          :Integer;     //counter through the new identifiers
begin
 for i := StartIndex to FActualIdents.Count - 1 do   //for all new identifiers
  //for all type-identifiers, try to link identifier references
  FActualIdents[i].ForEachIdentType(CallBackAfterLocalDefinition, nil);
end;




{Will be called for each ~[linkClass TIdentType] in the interface-section of
 all units. The type of the identifier will be searched and saved.
~param Ident  each of the identifiers from the class TIdentType
~param Parent the identifier that directly contains Ident
~param Data   application data; the top-level identifier, that contains Ident }
procedure TFileParser.CallBackIdentTypeInterface(Ident: TIdentType;
                                                 Parent: TIdentifier;
                                                 Data: TIdentifier);
 {Searches the type in the same unit and all its used units. }
 procedure SearchInSameUnit;
 var       TheType         :TIdentifier;  //the searched type
           Index           :Integer;      //counter through all used units
 begin
  //declared in same file?
  TheType := FThisFile.Idents.GetIdentByName(Ident.DefIdent);
  if Assigned(TheType) and                //and before this identifier?
     ((TheType.ForwardDefPos.Row > Data.Position.Row) or
      ((TheType.ForwardDefPos.Row = Data.Position.Row) and
       (TheType.ForwardDefPos.Column > Data.Position.Column))) then
   TheType := nil;

  if not Assigned(TheType) then           //not declared in this file?
   begin
    //search in all used units
    Index := FThisFile.UsedUnitList[fpInterface].Count - 1;
    while not Assigned(TheType) and (Index >= 0) do
     begin
      //identifier declared in used unit?
      TheType := TPascalFile(FThisFile.UsedUnitList[fpInterface].
                             Objects[Index]).Idents.
                                                GetIdentByName(Ident.DefIdent);
      //identifier found and not in interface?
      if Assigned(TheType) then
       if TheType.Scope <> sInterface then
        TheType := nil                          //no identifier found!
       else
        Inc(FUnitUsage[fpInterface][Index]);    //count reference

      Dec(Index);                           //search next used unit
     end;