uparse.pas

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

     FProgress.SetProgressText(Format('Testing %s...', [RecordKindNames[rk]]));

     IdentList.RemoveAll(False);            //clear list
     for i := 0 to Count - 1 do             //search each file
      begin
       FileD := List[i];                      //get the file
       FProgress.SetProcessText(Format('File %d of %d: %s',
                                      [i + 1, Count, FileD.InternalFileName]));

       for j := 0 to FileD.Idents.Count - 1 do
        begin
         Ident := FileD.Idents[j];        //each record-like type of the kind
         if (Ident is TRecordType) and (TRecordType(Ident).Kind = rk) then
          begin
           S := LowerCase(Ident.Name);      //get name of the type
           //identifier of that name already added? count the number of times
           Index := 0;
           SearchIndex := 0;
           while assigned(IdentList.GetIdentByNameList(S, SearchIndex)) do
            inc(Index);
           //save the index in the list of identifiers with the same name
           Ident.InternalNameIndex := Index;

           //add a warning for each double name once (and ignore templates)
           if (Index = 1) and not Ident.EffectiveFile.IncludedCode then
            AddHint(Format('There is more than one %s with the name "%s".',
                           [RecordKindNames[rk], Ident.Name]));

           IdentList.AddIdent(Ident);       //add the identifier to the list
          end //if Ident is TRecordType and Kind = rk
        end; //for j := 0 to FileD.Idents.Count

       FProgress.StepProgress;
      end; //for i := 0 to List.Count - 1
    end; //for rk := high(rk) downto low(rk)


   FProgress.SetProgressText('Testing Functions...');
   for i := 0 to Count - 1 do              //for each file
    begin
     FileD := List[i];                       //get the file
     FProgress.SetProcessText(Format('File %d of %d: %s',
                                    [i + 1, Count, FileD.InternalFileName]));

     IdentList.RemoveAll(False);             //clear list
     for j := 0 to FileD.Idents.Count - 1 do
      begin
       Ident := FileD.Idents[j];
       if Ident is TFunction then              //for each function in the file
        begin
         S := LowerCase(Ident.Name);             //get its name

         //function with same name already found? count the number of times
         Index := 0;
         SearchIndex := 0;
         while assigned(IdentList.GetIdentByNameList(S, SearchIndex)) do
          inc(Index);
         //save the index in the list of functions with the same name
         Ident.InternalNameIndex := Index;

         IdentList.AddIdent(Ident);              //add it to the list
        end; //if Ident is TFunction
      end; //for j := 0 to FileD.Idents.Count - 1

     FProgress.StepProgress;
    end; //for i := 0 to Count - 1

 finally
  IdentList.RemoveAll(False);             //free the list
  IdentList.Free;
 end;

 FProgress.Reset;
 FProgress.SetWorkText('Checking for abstract classes...');
 FProgress.SetProgressText('');
 FProgress.SetProcessText('');
 //check and save for each class if it is abstract
 List.CheckAbstractClasses;

{$IFOPT C+}
 FProgress.Reset;
 FProgress.SetWorkText('Testing links of record-likes (debug test)...');
 FProgress.SetProgressText('');
 FProgress.SetProcessText('');
 //test the inheritance-hierarchy-linking between record-like types
 for rk := high(rk) downto low(rk) do
  assert(TestRecordLikeLinks(rk, List));
{$ENDIF}

 FProgress.Reset;
 FProgress.SetWorkText('Finished parsing source-files!');
 FProgress.SetProgressText('Finished!');
 FProgress.SetProcessText('');
 FProgress.SetMaximum(1);
 FProgress.StepProgress;
end;


































{Checks the file and parses it, unless it is selected that it should not be
 parsed. If the file is parsed, an object of the class set in
 ~[link FParserClass] will be created for the file. Then the compiler switches
 will be read if available and the kind of the file will be read and the first
 uses-clause. Finally, all used units may be parsed if it is a project and the
 parsing should be recursive.

~todo "TheFile.ProjectFile :=" may cause problems (or at least is/may be wrong)
      when libary paths are defined (library files should not be assigned to a
      project, don't they? what if they are in multiple projects)

~param Name       the name of the file to parse with its absolute path
~param Recursive  if all used/contained files should be parsed, in case it is a
                  project file
~param Dirs       all directories in which parsing is permitted;
                  must be the absolute short names; that's means they're unique
~param NotFiles   list of files not to parse
~param NotDirs    all directories in which parsing is forbidden;
                  must be the absolute short names; that's means they're unique
~param UseDefines the defines to use, if nil use the default defines }
procedure TParserManager.ParseFile(Name: String; Recursive: Boolean;
                                   Dirs, NotFiles, NotDirs: TStrings;
                                   UseDefines: TDefines = nil);

 {Checks if the Text is in the list, that means if the path of a file is in a
  list of files. TStrings.IndexOf can't be used, because that uses an
  ANSI-comparison and is case insensitive.
 ~param Text the text to test if it is in the list
 ~param List the list in which Text should be searched in
 ~result if an entry with the text is in the list }
 function InList(const Text: String; List: TStrings): Boolean;
 var      i     :Integer;                  //counter through the list
 begin
  i := List.Count - 1;
  while (i >= 0) and (List[i] <> Text) do  //run through list until found
   dec(i);
  Result := i >= 0;                        //return if found
 end;


var       FileParser         :TFileParser; //parser of the file
          Defines            :TDefines;    //to set compiler options etc.

 {Parses all unit in the string given by a uses-clause.
 ~param UsesString the string of a uses-clause }
 procedure ParseUnits(const UsesString: String);
 var       Parser              :TTokenParser; //to parse the uses-string
           Separator           :String;       //token of the separating comma
           UnitName, UnitFile  :String;       //name of a unit and its file
           i                   :Integer;     //counter through the directories
 begin
  Parser := TTokenParser.Create;         //create parser for the uses-clause
  try
    Parser.ParseString(UsesString);      //parse the uses-string

    //parse whole uses-/contains-clause
    while Parser.GetIdentWithPointsToken(UnitName) do
     begin
      if Parser.GetToken(UnitFile) then      //not end of uses-clause?
       if LowerCase(UnitFile) = 'in' then      //name of file given?
        begin                                    //read name of file
         if not Parser.GetToken(UnitFile) or (length(UnitFile) < 3) or
            (UnitFile[1] <> '''') or (UnitFile[length(UnitFile)] <> '''') then
          FileParser.ExceptionAtStart(etSyntax,
                                      '"''Path\To\Unit.pas''" expected in uses-clause after "in"!');
         //read separating comma ,
         if Parser.GetToken(Separator) and (Separator <> ',') then
          FileParser.ExceptionAtStart(etSyntax,
                                      '"," after "in ''...''" expected in uses-clause!');

         //extract name of file out of the string
         UnitFile := copy(UnitFile, 2, length(UnitFile) - 2);

         i := pos('''''', UnitFile);     //change all "''" to "'"
         while i <> 0 do
          begin
           Delete(UnitFile, i, 1);
           i := SearchString('''''', UnitFile, i + 1);
          end;

         if (UnitFile <> '') and (ExtractFileExt(UnitFile) = '') then
          UnitFile := UnitFile + '.pas';
        end
       else
        begin
         if UnitFile <> ',' then             //must be the separating comma ","
          FileParser.ExceptionAtStart(etSyntax,
                                      '"," or "in" expected in uses-clause!');

         UnitFile := Defines.DealiasUnit(UnitName) + '.pas';  //check for alias
        end
      else  //end of uses-/contains-clause
       UnitFile := Defines.DealiasUnit(UnitName) + '.pas';  //check for alias

{
      //no path of the file given?
      if (pos('\', UnitFile) = -1) and (ExtractFileDrive(UnitFile) = '') then
       begin
        i := 0;                             //try with all search-paths ...
        while (i < Defines.SearchPath.Count) and
              not FileExists(Defines.SearchPath[i] + UnitFile) do
         inc(i);
        if i < Defines.SearchPath.Count then    //found in search-path?
         UnitFile := Defines.SearchPath[i] + UnitFile  //set name with path
        else
         UnitFile := Defines.SearchPath[0] + UnitFile;  //does not exist!
       end
      else      //if it is a relative path
       if ((UnitFile = '') or not (UnitFile[1] in ['\', '/'])) and
          (ExtractFileDrive(UnitFile) = '') then
        UnitFile := Defines.SearchPath[0] + UnitFile;    //use program-path
}

      //in case of an absolute path in UnitFile,
      //                         this will check always the same path and name!

      assert(Defines.SearchPath.Count >= 1);

      if IsAbsolutePath(UnitFile) then      //path is absolute?
       UnitName := UnitFile                   //just use it
      else
       begin
        i := 0;                             //try with all search-paths ...
        repeat                                //get file in the path
          UnitName := ExtractShortPathName(ExpandFileName(
                GetAbsolutePathRelative(ExtractFilePath(Defines.SearchPath[i]),
                                        UnitFile)));
          inc(i);
        //until every path tried or file found
        until (i = Defines.SearchPath.Count) or FileExists(UnitName);
       end;

      //if file found and it is allowed to parse the file parse it
      if (UnitName <> '') and FileExists(UnitName) and
         FileDirAllowed(UnitName, Dirs, NotDirs) then
       //use the original name of the file, not the short
       ParseFile(ExtractFilePath(UnitName) + ExtractFileName(UnitFile), False,
                 Dirs, NotFiles, NotDirs, Defines);
     end;
  finally
   Parser.Free;  //free the parser of the uses-clause
  end;
 end;


var       FileName           :String;      //the name of the file without path
          TheFile            :TPascalFile; //the object representing the file
          Index              :Integer;     //the index of the first token
begin
 assert(assigned(FParserClass));
 assert(FParserClass.InheritsFrom(TFileParser));


 FileName := ExtractFileName(Name);        //get original name of file
 Name := ExtractShortPathName(ExpandFileName(Name));  //get unique path
 //parsing not forbidden and not already parsed?
 if (not assigned(NotFiles) or not InList(Name, NotFiles)) and
    not assigned(FList.GetFileAbsolute(Name)) then
  begin
   if assigned(FList.GetIncludedFileAbsolute(Name)) then
    AddWarning(Format('The file "%s" to parse was already read as an included file, this is very probably an error!: %s',
                      [FileName, Name]), nil);


   Defines := TDefines.Create;     //create the object of options for this file
   try
     TheFile := FList.AddFile(Name);        //read the file

     //create the parser
     FileParser := TFileParser(FParserClass.Create(TheFile));
     FileParser.CheckParseState := True;    //a parser of a complete file

     FileParser.SetContentToParse(TheFile.Lines); //pre-parse it


     //get kind of the file
//       IsWordIn(FileParser.GetFirstToken, FileStartWords, Index);
     if LowerCase(ExtractFileExt(Name)) = '.pas' then
      Index := ord(High(TSourceFileType))     //a unit
     else
      Index := -1;                            //a project

     //if it is a project file and auto-parsing of the options is enabled
     if FDefineOptions.AutoParse and
        ((Index = -1) {or
         (FileStartWordTypes[TSourceFileType(Index)] <> sftUnit)}) then
      begin
       //read the options from the .cfg/.conf-file of the project
       if FileExists(ExtractFilePath(Name) +
                     ChangeFileExt(FileName, '.conf')) then
        Defines.SetOptionsWithCFGFile(FDefineOptions,
                                      ExtractFilePath(Name) +
                                      ChangeFileExt(FileName, '.conf'))
       else
        Defines.SetOptionsWithCFGFile(FDefineOptions,
                                      ExtractFilePath(Name) +
                                      ChangeFileExt(FileName, '.cfg'));
      end
     else
      begin
       if assigned(UseDefines) then          //default-defines are given?
        Defines.CopyOptions(UseDefines)        //use them
       else                                    //compute the defines
        Defines.SetOptionsWithoutCFGFile(FDefineOptions);
       Defines.RequiredPackages.Clear;         //don't inherit packages
      end;

     //is a project?
     if (Index = -1) or
        (FileStartWordTypes[TSourceFileType(Index)] <> sftUnit) then
      //add its path to the search paths
      AddLocalSearchPath(Defines.SearchPath, ExtractFilePath(Name));


     //copy the defines - use same compiler defines
     TheFile.SetCompilerDefines(Defines, True);
     Defines.RequiredPackages.Clear;          //don't inherit packages


     FileParser.ParseFirstUsesClause;         //parse the head of the file

     //if it is a package and units should be parsed recursively
     if Recursive and (TheFile.FileType <> sftUnit) then
      begin
       ParseUnits(TheFile.UsesClauses[fpInterface]); //parse all
       ParseUnits(TheFile.UsesClauses[fpMain]);      //used/contained units
       Index := 0;
       TheFile := FList[Index];
       while TheFile <> FileParser.ThisFile do  //for all new parsed/used files
        begin
         if not assigned(TheFile.ProjectFile) then
          TheFile.ProjectFile := FileParser.ThisFile;  //set this project file
         inc(Index);
         TheFile := FList[Index];
        end;
      end;

   finally
    Defines.Free;                             //free the options
   end;
  end; //if file should be parsed
end;







{Parses the files and adds them to the list. This function is used to parse