usaveparsed.pas

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

{$IFNDEF LINUX}
   ShowDebugText(FFileTree, 'Files');
{$ENDIF}
{$ENDIF}
 finally
  try
    FreeTree(FFileTree);                     //free the tree of all files
  finally
   FFileTree := nil;
  end;
 end;
end;













{Reads parsed data from the file. }
procedure TParsedDataStream.ReadData;

 {Read all classes and their version.
 ~param Version the version of the data in the file }
 procedure ReadClasses(Version: DWORD);
 var       i                :Integer;     //counter through all classes
           ClassPointer     :PIdentifierClass;   //runner through classes
           VersionPointer   :PIdentClassVersion; //runner through versions
           TConstAvail      :Boolean;     //if the class TConstant is used
 begin
  FClassCount := ReadComprInt;            //read number of classes

  //create arrays for classes and their versions
  GetMem(FClasses, (FClassCount + 3) * SizeOf(FClasses^));
  GetMem(FClassDataVersion, (FClassCount + 3) * SizeOf(FClassDataVersion^));
  ClassPointer := FClasses;
  VersionPointer := FClassDataVersion;

  TConstAvail := False;                   //TConstant not used so far
  for i := 0 to FClassCount - 1 do        //read all classes
   begin
    //read name of class and add the class
    ClassPointer^ := FindClassByName(ReadString);
    TConstAvail := TConstAvail or (ClassPointer^ = TConstant);
    VersionPointer^ := ReadComprInt;                  //save and check version
    if not ClassPointer^.CheckVersion(VersionPointer^) then
     raise Exception.CreateFmt('Can''t load file, Version of data of identifier class "%s" don''t match: %d (current: %d)',
                               [ClassPointer^.ClassName, VersionPointer^,
                                ClassPointer^.GetVersion]);

    inc(ClassPointer);                      //next class
    inc(VersionPointer);
   end;

  if not TConstAvail then                 //TConstant not used?
   begin
    assert(Version = 0);

    ClassPointer^ := TConstant;             //insert TConstant
    VersionPointer^ := 0;     //in file version 0 it has always been version 0!
    inc(ClassPointer);                      //next class
    inc(VersionPointer);
   end;

  ClassPointer^ := nil;                   //end the list
  VersionPointer^ := -1;
 end;

 {Read number of files and create them.
 ~param Version the version of the data in the file }
 procedure CreateFiles(Version: DWORD);
 begin
  FNormalFileCount := ReadComprInt;                 //read number of files
  //read number of included files
  if Version < 3 then                               //old version of data?
   FFileCount := FNormalFileCount                     //assume 0
  else
   FFileCount := FNormalFileCount + ReadComprInt;     //add included files

  //create all files
  FFileList.AddEmptyFiles(FNormalFileCount, FFileCount - FNormalFileCount);
 end;

 {Read number of identifiers and create them.
 ~param Version the version of the data in the file }
 procedure CreateIdentifiers(Version: DWORD);
 var       i                :Integer;       //counter through all identifiers
 begin
  FIdentifierCount := ReadComprInt;         //read number of identifiers

  //create array for all identifiers to free
  GetMem(FFree, FIdentifierCount * SizeOf(FFree^));
  //free them by default, until changed (owned)
  FillChar(FFree^, FIdentifierCount * SizeOf(FFree^), True);

  for i := 0 to FIdentifierCount - 1 do     //create all identifiers
   FIdents.AddIdent(FindClassByIndex(ReadComprInt).Create);  //of their classes
 end;

 {Initializes all files.
 ~param Version the version of the data in the file }
 procedure InitFiles(Version: DWORD);
          //default compiler options etc. of all files
 var      Defines          :TDefines;
          //default compiler options etc. of all files
          DefineOptions    :TDefineOptions;
          i                :Integer;            //counter through all files
 begin
  //set default compiler options for each file
  Defines := TDefines.Create;                       //create options
  try
    DefineOptions := TDefineOptions.Create;         //create default options
    try
      Defines.SetOptionsWithoutCFGFile(DefineOptions); //get default options
    finally
     DefineOptions.Free;                            //don't need it anymore
    end;

    //set default compiler options for each file
    for i := 0 to FNormalFileCount - 1 do
     FFileList[i].SetCompilerDefines(Defines, True);
    for i := 0 to FFileCount - FNormalFileCount - 1 do
     FFileList.Included[i].SetCompilerDefines(Defines, True);
  finally
   Defines.Free;                                    //free options
  end;
 end;




 {Makes sure all enumeration types have references to their items for old
  data. }
 procedure CheckEnumerationItems;
 var       i                    :Integer;         //counter through identifiers
           Ident                :TIdentifier;     //each identifier
 begin
  for i := 0 to FIdentifierCount - 1 do           //for each identifier
   begin
    Ident := FIdents[i];                            //get it
    if Ident is TEnumTypeItem then                  //item of an enumeration?
     begin
      assert(assigned(TEnumTypeItem(Ident).EnumType));
      assert(not TEnumTypeItem(Ident).EnumType.Items.IsIn(Ident));
      TEnumTypeItem(Ident).EnumType.Items.AddIdent(Ident); //add it to the type
     end;
   end;
 end;


 {Gets the position in the file from the internal position.
 ~param TheFile  the file containing the position
 ~param Internal the internal in the parser used position in the file
 ~result the position in the file }
 function GetFilePosition(TheFile: TPascalFile;
                          Internal: TPosition): TPosition;

  {Returns the column without comments deleted.
  ~param Column       the column in the line without comments
  ~param Line         the text of the line
  ~param StartComment the comment the row starts in
  ~result the column in the line without the comments deleted }
  function GetColumnInLine(Column: Integer; Line: String;
                           StartComment: TCommentType): Integer;
  var      pc                :PChar;     //runner through the text
           i                 :Integer;   //result of pos
  begin
   Result := 1;
   //if the string starts in a comment, delete everything up to the end of it
   case StartComment of
     ctCurly:     begin // delete text up to the closing curly brace '}'
                   i := pos('}', Line);   //search '}'
                   if i = 0 then
                    Line := ''
                   else
                    begin
                     Delete(Line, 1, i);      //delete comment and
                     inc(Result, i);          //increment result-column
                    end;
                  end;
     ctBraceStar: begin // delete text up to the star-brace '*)'
                  i := pos('*)', Line);   //search '*)'
                   if i = 0 then
                    Line := ''
                   else
                    begin
                     inc(i);
                     Delete(Line, 1, i);    //delete comment and
                     inc(Result, i);        //increment result-column
                    end;
                 end;
   end;



   //as long as column not reached and there is something in the line
   while (Column > 0) and (Line <> '') do
    begin
     pc := Pointer(Line); //search next comment or string
     while (pc^ <> #0) and not (pc^ in ['''', '{']) and
           not ((pc^ = '/') and (PChar(Cardinal(pc) + 1)^ = '/')) and
           not ((pc^ = '(') and (PChar(Cardinal(pc) + 1)^ = '*')) do
      inc(pc);


     i := pc - Pointer(Line);           //length of normal text
     Delete(Line, 1, i);                //delete normal text
     dec(Column, i);                    //decrement column in line
     inc(Result, i);                    //increment result-column
     if Column <= 0 then                //column was in the text?
      inc(Result, Column - 1);            //decrement again from end

     //if the end of the line wasn't reached
     if (Column > 0) and (Line <> '') then
      begin
       case Line[1] of
         '/':  begin
                Line := '';    //comment to the end of the line, that's the end
                Column := 0;
               end;
         '''': begin
                Delete(Line, 1, 1);           //cut text in '' (inclusive '')
                i := pos('''', Line);
                if i = 0 then
                 Line := ''                     //error: unclosed string !
                else
                 Delete(Line, 1, i);

                inc(i);                       //add the first ' again
                dec(Column, i);               //decrement column in line
                inc(Result, i);               //increment result-column
                if Column <= 0 then           //column was in the string?
                 inc(Result, Column - 1);       //decrement again from end
               end;
         '{':  begin //search '}' in the text, cut comment
                i := pos('}', Line);
                if i = 0 then
                 Line := ''                   //end of line reached
                else
                 begin
                  Delete(Line, 1, i);
                  inc(Result, i);             //increment result-column
                  dec(Column);                //skip the inserted (white)space
                 end;
               end;
         '(':  begin //search '*)' in the text, cut comment
                Delete(Line, 1, 2);   //(*) <-- this is not a comment by itself
                i := pos('*)', Line);
                if i = 0 then
                 Line := ''                   //end of line reached
                else
                 begin
                  Delete(Line, 1, i + 1);
                  inc(Result, i + 2 + 1);     //increment result-column
                  dec(Column);                //skip the inserted (white)space
                 end;
               end;
       end;  //case Line[1]
      end  //if Column > 0 and Line <> ''
    end; //while Column > 0 and Line <> ''
  end;


 begin
  Result := Internal;        //return value is based on the internal position
  if (Result.Row >= 0) then    //a valid position?
   begin
    if Result.Column <= 0 then //column not valid?
     Result.Column := 1
    else                         //calculate position with comments
     Result.Column := GetColumnInLine(Result.Column,
                                      TheFile.Lines[Result.Row],
                                      TheFile.LineStartComment[Result.Row]);
    inc(Result.Row);           //1-based index of lines
   end
  else
   begin
    Result.Row := 0;           //return the invalid position
    if Result.Column < 0 then
     Result.Column := 0;
   end;
 end;




type      PLongInt = ^LongInt;                  //version of file as a number
          //buffer to read the magic of the file
var       MagicBuffer      :packed array[1..SizeOf(FileMagic)] of Byte;
          //buffer to read the version of the file
          VersionBuffer    :packed array[0..
                                         SizeOf(FileVersionSave) - 1] of Byte;
          Version          :DWORD;              //the version of the file
          //the version of the data of the list of files in the file
          FileListVersion  :TFileListVersion;
          //the version of the data of the files in the file
          FileVersion      :TIdentClassVersion;
          i                :Integer;            //general counter
          Ident            :TIdentifier;        //each identifier
          IdentVersion     :TIdentClassVersion; //version of classes
          SamePos          :Boolean;            //if both positions are equal
          Free             :PBoolean;           //counter through FFree
begin
 assert(assigned(FFileList));
 assert(FFileCount = -1);

 //read and check magic of file
 FStream.ReadBuffer(MagicBuffer, SizeOf(MagicBuffer));
 if not CompareMem(@MagicBuffer, @FileMagic, SizeOf(MagicBuffer)) then
  raise Exception.Create('Invalid file, Magic doesn''t match!');

 //read and check version of file
 FStream.ReadBuffer(VersionBuffer, SizeOf(VersionBuffer));
 Version := ((VersionBuffer[0] shl 8 or VersionBuffer[1]) shl 8 or
              VersionBuffer[2]) shl 8 or VersionBuffer[3];
 if Version > Version then
  raise Exception.Create('Can''t load file, version doesn''t match!');


 if Version >= 2 then              //file has data for the list of files?
  FileListVersion := ReadComprInt    //read version of data of list of files
 else
  FileListVersion := 0;              //no data to read
 if not FFileList.CheckVersion(FileListVersion) then
  raise Exception.Create('Can''t load file, version of the data of the list of files doesn''t match!');


 if Version < 3 then
  ReadString;                      //skip name of class of parsers
 FileVersion := ReadComprInt;
 if not TPascalFile.CheckVersion(FileVersion) then
  raise Exception.Create('Can''t load file, versions of data of files don''t match!');

 ReadClasses(Version);             //read all classes and their version

 //load data of the list of files besides the files themselves
 FFileList.Load(Self, FileListVersion);


 CreateFiles(Version);             //read number of files and create them
 CreateIdentifiers(Version);       //read number of identifiers and create them

 InitFiles(Version);               //initialize all files


 for i := 0 to FNormalFileCount - 1 do             //load all files from stream
  FFileList[i].Load(Self, FileVersion);
 for i := 0 to FFileCount - FNormalFileCount - 1 do
  FFileList.Included[i].Load(Self, FileVersion);


 for i := 0 to FIdentifierCount - 1 do             //load all identifiers
  begin
   Ident := FIdents[i];                              //get identifier
   //and the version of its data
   IdentVersion := FindClassVersion(TIdentifierClass(Ident.ClassType));

   //set marker to check for errors when reading the indices of arrays
   FCheckArrayIndices := (Version < 3) and (Ident.ClassType = TArrayType);

   Ident.Load(Self, IdentVersion);

   FCheckArrayIndices := False;
  end;


 //"repair" indices of arrays
// if SearchClassVersion(TArrayType, IdentVersion) and (IdentVersion < 4) then




 if Version < 3 then                               //old data?
  begin
   CheckEnumerationItems;              //fix enumeration references

   //make sure, all identifiers have a reference to the file containing it
   for i := 0 to FIdentifierCount - 1 do
    begin
     Ident := FIdents[i];
{
     if not assigned(Ident.InFile) and (Ident.Name <> '') and
        not (Ident is TParameter) and
        (not assigned(FMemberOf) or (FMemberOf.Name <> '')) then
      raise Exception.Create('Identifier does not have a reference on its file!');
}

     //using old, internal positions, so translate to the normal positions
     if assigned(Ident.InFile) then
      begin
       SamePos := (Ident.Position.Row = Ident.ForwardDefPos.Row) and
                  (Ident.Position.Column = Ident.ForwardDefPos.Column);
       Ident.Position := GetFilePosition(Ident.InFile, Ident.Position);
       if SamePos then
        Ident.ForwardDefPos := Ident.Position
       else
        Ident.ForwardDefPos := GetFilePosition(Ident.InFile,
                                               Ident.ForwardDefPos);
       Ident.EffectivePosition := Ident.Position;
       Ident.EffectiveForwardPosition := Ident.ForwardDefPos;
      end; //if assigned(Ident.InFile)
    end; //for i := 0 to FIdentifierCount - 1
  end; //if Version < 3


 Free := FFree;
 for i := 0 to FIdentifierCount - 1 do             //check if all identifiers
  begin                                              //have been used
   if Free^ then
    raise Exception.Create('There are unused identifiers!');
   inc(Free);
  end;

 //check for each class if it is abstract
 FFileList.CheckAbstractClasses;
end;

end.