usaveparsed.pas

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

         Compressed       :TMemoryStream;        //the compressed string
         Decompressor     :TDecompressionStream; //compressor of content
         Uncompressed     :TStringStream;        //the uncompressed string
begin
 Result := '';
 len := ReadComprInt;                            //read length of string
 if len <> 0 then                                //not empty?
  begin
   if len < 0 then
    raise Exception.CreateFmt('Invalid, negative length of string: %d', [len]);


    //create stream for the compressed string
   Compressed := TMemoryStream.Create;
   try
     Compressed.SetSize(len);                      //set capacity
     Compressed.Position := 0;
     Compressed.CopyFrom(FStream, len);            //and copy compressed string
     Compressed.Position := 0;                     //to be read again

     //create the decompressor
     Decompressor := TDecompressionStream.Create(Compressed);
     try
       //create stream for the uncompressed string
       Uncompressed := TStringStream.Create('');
       try
         //copy from compressed- to uncompressed string stream while
         //decompressing
         CopyFrom(Decompressor, Uncompressed);
         //TStream.CopyFrom does a seek to the end to get the size,
         //that is not allowed for TDecompressionStream

         Result := Uncompressed.DataString;        //return decompressed string

       finally
        Uncompressed.Free;                         //free decompressed string
       end;
     finally
      Decompressor.Free;                           //free decompressor
     end;
   finally
    Compressed.Free;                               //free compressed string
   end;
  end
 else
  Result := '';                                    //return an empty string
end;



{Reads a reference on an identifier from the stream.
~param Owned if the identifier is owned and freed from by identifier
             (i.e. in case of an error while reading don't free this
              identifier anymore)
~result the read reference on an identifier }
function TParsedDataStream.ReadIdent(Owned: Boolean = False): TIdentifier;
var      Index            :Integer;         //index of the identifier
         Free             :PBoolean;        //memory, if identifier is owned
begin
 Index := ReadComprInt;                     //read index of identifier
 if Index <> -1 then                        //nil reference?
  begin
   if (Index < 0) or (Index >= FIdentifierCount) then
    raise Exception.CreateFmt('Invalid index of identifier: %d (max: %d)',
                              [Index, FIdentifierCount]);

   if Owned then                              //is owned (no need to free it
    begin                                            //later in case of errors)
     Free := FFree;
     inc(Free, Index);
     if not Free^ then                          //already owned?
      raise Exception.Create('Identifier is already owned, can''t be again!');
     Free^ := False;                            //now it is owned
    end;

   Result := FIdents[Index];                  //return the identifier
  end
 else
  Result := nil;                              //return nil
end;



{Reads a reference on a file from the stream.
~result the read reference on a file }
function TParsedDataStream.ReadFile: TPascalFile;
var      Index            :Integer;         //index of the file
begin
 Index := ReadComprInt;                     //read index of file
 if Index <> -1 then                        //nil reference?
  begin
   if (Index < 0) or (Index >= FFileCount) then
    raise Exception.CreateFmt('Invalid index of file: %d (max: %d)',
                              [Index, FFileCount]);

   if Index < FNormalFileCount then           //is not an included file?
    Result := FFileList[Index]                  //return the file or the
   else
    Result := FFileList.Included[Index - FNormalFileCount]; //included file
  end
 else
  Result := nil;                              //return nil
end;























{Returns the index of the class in FClasses.
~param TheClass the class for which the index should be returned
~result the index of the class in FClasses }
function TParsedDataStream.FindClassIndex(TheClass: TIdentifierClass): Integer;
var      ClassPointer     :PIdentifierClass;   //runner through the list
begin
 Result := 0;
 ClassPointer := FClasses;                     //run through list and search it
 while assigned(ClassPointer^) and (ClassPointer^ <> TheClass) do
  begin
   inc(Result);
   inc(ClassPointer);
  end;
 if not assigned(ClassPointer^) then
  raise Exception.Create('Unknown class to write!');
end;




{Returns the class of identifiers by its name.
~param Name the name of the class to return
~result the class of identifiers with the given name }
function TParsedDataStream.FindClassByName(const Name: String):
                                                              TIdentifierClass;
var      i                :Integer;     //counter through the known classes
begin
 i := High(AllIdentClasses);
 while (i > Low(AllIdentClasses)) and   //run through array until found
       not AllIdentClasses[i].ClassNameIs(Name) do
  dec(i);

 if not AllIdentClasses[i].ClassNameIs(Name) then
  raise Exception.Create('Invalid class of identifiers in file found: ' +
                         Name);
 Result := AllIdentClasses[i];          //return class
end;

{Returns the class of identifiers by the index.
~param Index the index of the class to return
~result the class at the given index }
function TParsedDataStream.FindClassByIndex(Index: Integer): TIdentifierClass;
var      ClassPointer     :PIdentifierClass;   //entry in the list
begin
 if (Index < 0) or (Index >= FClassCount) then
  raise Exception.Create('Invalid index of class in file!');

 ClassPointer := FClasses;
 Inc(ClassPointer, Index);
 Result := ClassPointer^;                      //return the class
end;

{Returns the version of the data in this file of the class.
~param TheClass the class for which the version should be returned
~result the version of the data of the class }
function TParsedDataStream.FindClassVersion(TheClass:
                                         TIdentifierClass): TIdentClassVersion;
var      ClassPointer     :PIdentifierClass;   //runner through the classes
         VersionPointer   :PIdentClassVersion; //runner through the versions
begin
 VersionPointer := FClassDataVersion;
 ClassPointer := FClasses;
 Assert(Assigned(ClassPointer));
 while ClassPointer^ <> TheClass do            //search class in list
  begin
   Inc(VersionPointer);
   Inc(ClassPointer);
   Assert(Assigned(ClassPointer^));
  end;
 Result := VersionPointer^;                    //return version of class
end;

(*
{Searches the version of the data of the class.
~param TheClass the class for which the version should be searched
~param Version  out: the version of the data of the class
~result whether identifiers of the type are in the data being loaded }
function TParsedDataStream.SearchClassVersion(TheClass: TIdentifierClass;
                                     var Version: TIdentClassVersion): Boolean;
var      ClassPointer     :PIdentifierClass;   //runner through the classes
         VersionPointer   :PIdentClassVersion; //runner through the versions
begin
 VersionPointer := FClassDataVersion;
 ClassPointer := FClasses;
 Assert(Assigned(ClassPointer));
 //search the class in the list
 while Assigned(ClassPointer^) and (ClassPointer^ <> TheClass) do
  begin
   Inc(VersionPointer);
   Inc(ClassPointer);
  end;
 Result := Assigned(ClassPointer^);            //class found?
 if Result then
  Version := VersionPointer^;                    //return version of class
end;
*)





{Writes the parsed data to the file. }
procedure TParsedDataStream.WriteData;

 {Adds all identifiers to the list ~[link FIdents]. }
 procedure GetAllIdentifiers;
 var       i                :Integer;          //counter through files
 begin
  for i := 0 to FNormalFileCount - 1 do        //for each file
   FFileList[i].AddIdentifiersToList(FIdents);   //add all identifiers
 end;

 {Sets ~[link FClasses] to a list of all used classes. }
 procedure GetUsedClasses;
 var       i                :Integer;          //counter through identifiers
           IdentClass       :TIdentifierClass; //classes of the identifier
           ClassPointer     :PIdentifierClass; //runner through FClasses
 begin
  FClassCount := 0;                            //make list of used classes
  GetMem(FClasses, (high(AllIdentClasses) - low(AllIdentClasses) + 2) *
                   SizeOf(FClasses^));
  FillChar(FClasses^, (high(AllIdentClasses) - low(AllIdentClasses) + 2) *
                      SizeOf(FClasses^), Cardinal(nil));

  FClasses^ := TConstant;               //force TConstant for compiler options!

  for i := 0 to FIdentifierCount - 1 do        //for each identifier
   begin
    IdentClass := TIdentifierClass(FIdents[i].ClassType); //or its class
    ClassPointer := FClasses;
    while assigned(ClassPointer^) and (ClassPointer^ <> IdentClass) do
     inc(ClassPointer);
    if not assigned(ClassPointer^) then          //not in list yet?
     ClassPointer^ := IdentClass;                  //add to list
   end;

  ClassPointer := FClasses;
  while assigned(ClassPointer^) do               //count number of classes
   begin
    inc(FClassCount);
    inc(ClassPointer);
   end;
  assert(FClassCount <= high(AllIdentClasses) - low(AllIdentClasses) + 1);
 end;

 {Writes all classes and the versions of their data to the stream. }
 procedure WriteClasses;
 var       ClassPointer     :PIdentifierClass; //runner through FClasses
 begin
  WriteComprInt(FClassCount);                  //write number of classes
  ClassPointer := FClasses;
  while assigned(ClassPointer^) do             //for each class
   begin
    WriteString(ClassPointer^.ClassName);        //write its name
    WriteComprInt(ClassPointer^.GetVersion);     //and its version
    inc(ClassPointer);
   end;
 end;

 {Creates the tree of all files. }
 procedure CreateFileTree;
 var       i                :Integer;                  //counter through files
 begin
  for i := 0 to FNormalFileCount - 1 do                //add all files
   FFileTree := AddObject(FFileTree, FFileList[i], i);
  for i := 0 to FFileCount - FNormalFileCount - 1 do   //add all included files
   FFileTree := AddObject(FFileTree, FFileList.Included[i],
                          i + FNormalFileCount);
  FFileTree := BalanceTree(FFileTree);                 //optimize the tree
 end;

 {Creates the tree of all identifiers. }
 procedure CreateIdentifierTree;
 var       i                :Integer;          //counter through identifiers
 begin
  for i := 0 to FIdentifierCount - 1 do               //add all identifiers
   FIdentifierTree := AddObject(FIdentifierTree, FIdents[i], i);
  FIdentifierTree := BalanceTree(FIdentifierTree);    //optimize the tree
 end;

 {Saves all files and identifiers into the stream. }
 procedure SaveFilesAndIdentifiers;
 var       i                :Integer;          //counter through lists
 begin
  for i := 0 to FNormalFileCount - 1 do        //save each file into the stream
   FFileList[i].Save(Self);
  for i := 0 to FFileCount - FNormalFileCount - 1 do
   FFileList.Included[i].Save(Self);

  for i := 0 to FIdentifierCount - 1 do        //save each identifier
   FIdents[i].Save(Self);
 end;


{$IFOPT C+}
{$IFNDEF LINUX}

 {Shows some information about the tree.
 ~param Tree  the tree to show Information about
 ~param Title the title of the content of the tree }
 procedure ShowDebugText(Tree: PClassIndexBinTree; const Title: String);
 var       Min, Max     :Integer;         //extreme level depths of the tree
 begin
  if assigned(Tree) then                  //not empty?
   begin
    Min := High(Min);
    Max := -1;
    GetMinMax(Tree, 1, Min, Max);           //calculate min/max depth
    OutputDebugString(PChar(Format('%s: Min: %d; Max: %d',  //and show them
                                   [Title, Min, Max])));
    assert((Min = Max) or (Min = Max - 1));
   end
  else
   OutputDebugString(PChar('No ' + Title + '!'));
 end;

{$ENDIF}
{$ENDIF}

var       i                :Integer;          //general counter
{$IFOPT C+}
          //to check, if identifiers are added multiple times
          j                :Integer;
          Ident            :TIdentifier;      //all identifiers
{$ENDIF}
begin
 assert(assigned(FFileList));
 assert(FFileCount = -1);



 FNormalFileCount := FFileList.Count;         //get number of files
 FFileCount := FNormalFileCount + FFileList.IncludedFileCount;

 GetAllIdentifiers;                           //get all identifiers
 FIdentifierCount := FIdents.Count;           //and their number

{$IFOPT C+}
 //make sure every identifier has only be added once
 for i := 0 to FIdentifierCount - 1 do
  begin
   Ident := FIdents[i];
   for j := i + 1 to FIdentifierCount - 1 do
    assert(Ident <> FIdents[j]);
  end;
{$ENDIF}

 GetUsedClasses;                              //get all used classes



 FStream.WriteBuffer(FileMagic, SizeOf(FileMagic));     //write file magic
 //write file version
 FStream.WriteBuffer(FileVersionSave, SizeOf(FileVersionSave));

 WriteComprInt(FFileList.GetVersion);         //write version of list of files
 //write version of content of files
 WriteComprInt(TPascalFile.GetVersion);
 WriteClasses;                                //write all classes


 //write data of the list of files besides the files themselves
 FFileList.Save(Self);

 WriteComprInt(FNormalFileCount);              //write number of files
 WriteComprInt(FFileCount - FNormalFileCount); //write number of included files
 WriteComprInt(FIdentifierCount);              //and number of identifiers

 for i := 0 to FIdentifierCount - 1 do         //write class of each identifier
  WriteComprInt(FindClassIndex(TIdentifierClass(FIdents[i].ClassType)));


 try
   CreateFileTree;                           //create tree for all files

   try
     CreateIdentifierTree;                   //create tree for all identifiers

     //save each file and identifier into the stream
     SaveFilesAndIdentifiers;



{$IFOPT C+}
{$IFNDEF LINUX}
     OutputDebugString(PChar(Format('%d Files; %d Identifiers',
                                    [FFileCount, FIdentifierCount])));
     ShowDebugText(FIdentifierTree, 'Identifiers');
{$ENDIF}
{$ENDIF}
   finally
    try
      FreeTree(FIdentifierTree);             //free the tree of all identifiers
    finally
     FIdentifierTree := nil;
    end;
   end;

{$IFOPT C+}