uextractsourcedoc.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 UExtractSourceDoc;

{Contains the generator-class ~[link TExtractSourceDoc] to extract the source
 code of the parsed files. }

interface

uses UBaseIdents,
     UOptions, UMakeDoc;

type

   { * * *  ***  * * *  ***   TExtractSourceDoc   ***  * * *  ***  * * *  }



  {Extends its base class to extract the source code of the parsed files.~[br]
   Parsed data can be save and loaded, so with this class the source code of a
   previously parsed project can be extracted. }
  TExtractSourceDoc = class(TMakeDoc)
  private
    //if the paths of the files should be ignored and all files saved directly
    FIgnorePaths: Boolean;                          //in the same directory
    //if always the whole path should be extracted;
    //without drive if possible and not ~[link FAlwaysIncludeDrive]
    FAbsolutePaths: Boolean;
    //if always a directory for the drive should be created (only if
    FAlwaysIncludeDrive: Boolean;                   //~[link FAbsolutePaths])
  protected

    //Returns the common part of the paths of all files.
    function GetMinPath: String;
    //Returns the path and name to save the file to. Will create directories if
    //needed.
    function GetFilePathName(Path: String; const CommonPath: String): String;

    //Process parsed data; extract the source code into files.
    function DoGenerateDocumentation: Boolean; override;
  public

    //Returns a description of the documentation of the generator.
    class function GetDescription: TGeneratorDescription; override;


    //Returns the number of available options in this class.
    class function GetOptionCount: Cardinal; override;
    //Gets a description of an option.
    class procedure GetOptionDescription(Index: Cardinal;
                                         var Desc: TOptionDescription);
                                                                      override;
    //Gets the value of an option.
    function GetOption(Index: Cardinal): TOptionValue; override;
    //Sets the value of an option.
    procedure SetOption(Index: Cardinal; const Value: TOptionValue); override;
  end;



implementation

uses Classes, SysUtils,
{$IFDEF VER120}
     FileCtrl,
{$ENDIF}
     General,
     UFilePaths;




   { * * *  ***  * * *  ***   TExtractSourceDoc   ***  * * *  ***  * * *  }


{Returns a description of the documentation of the generator.
~result a description of the documentation of the generator }
class function TExtractSourceDoc.GetDescription: TGeneratorDescription;
begin
 Result.Name := 'Extract Source Files';
 Result.Identification := 'ExtractSource';
 Result.Description :=
  'Extracts all parsed files in a specified directory.' + LineDelimiter +
  'More useful after loading (older) previously parsed data.' + LineDelimiter +
  'May give undesired results (the paths) if used to transfer between Windows and Unix or vice versa.';
end;






{Returns the number of available options in this class.
~result the number of available options }
class function TExtractSourceDoc.GetOptionCount: Cardinal;
begin
 Result := inherited GetOptionCount + 3;
end;

{Gets a description of an option.
~param Index index of the option to get data of
~param Desc  out: the description of the option (name, type, default value,
                  etc.)
~see GetOptionCount }
class procedure TExtractSourceDoc.GetOptionDescription(Index: Cardinal;
                                                 var Desc: TOptionDescription);
var             PreOptionCount   :Cardinal;     //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;    //get number of inherited ones
 if Index < PreOptionCount then                 //asked for inherited option?
  inherited GetOptionDescription(Index, Desc)     //forward to parent class
 else
  begin
   ClearDescription(Desc);               //clear structure
   case Index - PreOptionCount of        //depending on index of option
     0: begin                            //set the values describing the option
         Desc.Name := 'IgnorePaths';
         Desc.Category := 'Generation';
         Desc.Description := 'If the paths of the files should be ignored and all files saved directly in the given directory. Beware, if there are files with the same name.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := False;
        end;
     1: begin
         Desc.Name := 'AbsolutePaths';
         Desc.Category := 'Generation';
         Desc.Description := 'If always the whole path (without drive if possible) should be extracted.';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := False;
        end;
     2: begin
         Desc.Name := 'AlwaysIncludeDrive';
         Desc.Category := 'Generation';
         Desc.Description := 'If always a directory for the drive should be created (only if AbsolutePaths is true).';
         Desc.DataType := otBoolean;
         Desc.DefaultValue.BoolData := False;
        end;
   else
    assert(Index >= GetOptionCount);
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
 end;
end;



{Gets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to get the value of
~result the value of the option }
function TExtractSourceDoc.GetOption(Index: Cardinal): TOptionValue;
var      PreOptionCount   :Cardinal;            //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;    //get number of inherited ones
 if Index < PreOptionCount then                 //asked for inherited option?
  Result := inherited GetOption(Index)            //forward to parent class
 else
  begin
   case Index - PreOptionCount of               //depending on index of option
     0: Result.BoolData := FIgnorePaths;          //get the value
     1: Result.BoolData := FAbsolutePaths;
     2: Result.BoolData := FAlwaysIncludeDrive;
   else
    assert(Index >= GetOptionCount);
    raise EInvalidOption.Create('Invalid index for option supplied!');
   end;
  end;
end;

{Sets the value of an option. Call ~[link GetOptionDescription] to get the type
 and the meaning of the option.
~param Index index of the option to set the value
~param Value the new value of the option }
procedure TExtractSourceDoc.SetOption(Index: Cardinal;
                                      const Value: TOptionValue);
var       PreOptionCount   :Cardinal;         //number of inherited options
begin
 PreOptionCount := inherited GetOptionCount;  //get number of inherited ones
 if Index < PreOptionCount then               //asked for inherited option?
  inherited SetOption(Index, Value)             //forward to parent class
 else
  case Index - PreOptionCount of                //depending on index of option
    0: FIgnorePaths := Value.BoolData;            //set the option to the value
    1: FAbsolutePaths := Value.BoolData;
    2: FAlwaysIncludeDrive := Value.BoolData;
  else
   assert(Index >= GetOptionCount);
   raise EInvalidOption.Create('Invalid index for option supplied!');
  end;
end;












{Returns the common part of the paths of all files.
~result the common part of the paths of all files }
function TExtractSourceDoc.GetMinPath: String;
(*
 {Compares two strings and returns the first index of the different characters
  or the index after the last character in case they are equal.
 ~param S1, S2 the strings to compare, the first one has to be shorter
 ~result the index of the different characters }
 function ComparePos(const S1, S2: String): Integer;
 begin
  Result := 1;                      //start at the beginning
  if (S1 <> '') and (S2 <> '') then //strings not empty?
   //compare strings until characters are not equal or end of them reached
   while (S1[Result] = S2[Result]) and (S1[Result] <> #0) do
    inc(Result);
 end;

var      i         :Integer;        //counter through all files
*)
begin
 //complete path should be used, or no path at all?
 if FIgnorePaths or (FAbsolutePaths and FAlwaysIncludeDrive) then
  Result := ''                         //no common path (used)
 else
  begin
   Result := FFiles.GetCommonBasePath; //get common path
(*
   Result := FFiles[0].FilePath;      //use first path
   i := Files.Count - 1;              //for each file (or until no common path)
   while (i >= 1) and (Result <> '') do
    begin                               //delete not common part
     Delete(Result, ComparePos(Result, FFiles[i].FilePath),
            High(length(Result)));
     dec(i);
    end;

   i := Files.IncludedFileCount - 1;  //for each included file
   while (i >= 0) and (Result <> '') do             //(or until no common path)
    begin                               //delete not common part
     Delete(Result, ComparePos(Result, Files.Included[i].FilePath),
            High(length(Result)));
     dec(i);
    end;

   //make sure it ends with a directory and a "\" follows
   while (Result <> '') and not (Result[Length(Result)] in ['/', '\']) do
    Delete(Result, Length(Result), 1);
   //don't use empty directories
   if ((Length(Result) = 1) and (Result[1] in ['/', '\', '~'])) or
      (Result = '\\') then
    Result := '';
*)
   if Result <> '' then               //some common directories?
    begin
     Result := FFiles.GetLongPathName(Result); //get long, real version
     if FAbsolutePaths then                      //absolute paths?
      Result := ExtractFileDrive(Result);          //only drive may be skipped
    end;
  end;
end;


{Returns the path and name to save the file to. Will create directories if
 needed.
~param Path       the original path of the file
~param CommonPath the common part of the path the be ignored
~result the path and name of the file to save as }
function TExtractSourceDoc.GetFilePathName(Path: String;
                                           const CommonPath: String): String;
var      Tmp            :String;   //temporary buffer
begin
 Path := FFiles.GetLongPathName(Path); //get long real version of the path
 if FIgnorePaths then              //save all files in same directory?
  Path := ExtractFileName(Path)      //just use name of file
 else
  begin
   if CommonPath = '' then         //no common path?
    begin
     Tmp := ExtractFileDrive(Path);  //get drive / network share
     if Tmp <> '' then               //drive / network share given?
      if Tmp[1] = '\' then             //is a network share?
       begin
        assert(Path[2] = '\');
        Delete(Path, 1, 2);              //remove the two leading "\\"
       end
      else
       begin                           //it is (should be) a drive
        assert(Path[1] in ['A'..'Z', 'a'..'z']);
        assert(Path[2] = ':');
        assert(Path[3] in ['/', '\']);
//         Delete(Path, 1, 3);
        Delete(Path, 2, 1);            //delete ":" - it is a simple directory
       end;
    end //if CommonPath = ''
   else
    begin
     assert(CommonPath = copy(Path, 1, length(CommonPath)));
     Delete(Path, 1, length(CommonPath));   //delete common part of the path
    end;

   //create the directory/ies to save in
   ForceDirectories(GetAbsolutePathCurrent(ExtractFilePath(FDestPath + Path)));
  end;

 Result := Path;                   //return the path
end;












{Process parsed data; i.e. in this case save the source code of the parsed
 files into files in a directory tree.
~result whether the files have been successfully saved and it hasn't been
        aborted }
function TExtractSourceDoc.DoGenerateDocumentation: Boolean;
var      MinPath          :String;      //common part of all paths
         Count            :Integer;     //number of files
         i                :Integer;     //counter through file
         FileD            :TPascalFile; //the files
begin
 CreateDocumentationDirectory;          //create path of the main directory

 Count := FFiles.Count;                 //get number of files

 Progress.Reset;
 Progress.SetThrowExceptionOnStepIfAbort(True);

 Progress.SetWorkText('Saving Files...');
 Progress.SetProgressText('');
 Progress.SetProcessText('');

 Progress.SetMaximum(Count);

 if (Count <> 0) or (Files.IncludedFileCount <> 0) then //files to extract?
  begin
   MinPath := GetMinPath;                 //get common part of the paths

   for i := 0 to Count - 1 do             //for each file
    begin
     FileD := FFiles[i];                    //get the file

     Progress.SetProgressText(Format('Writing File %d of %d',
                                     [i + 1, Count]));
     Progress.SetProcessText(FileD.InternalFileName);

     if not DoNotDocumentFile(FileD) then
      //get name and path of file to save to, and save the file
      FileD.Lines.SaveToFile(FDestPath +
                             GetFilePathName(FileD.FilePath, MinPath));

     Progress.StepProgress;
    end;


   Count := Files.IncludedFileCount;
   Progress.SetMaximum(Count);
   for i := 0 to Count - 1 do                   //for each included file
    begin
     FileD := FFiles.Included[i];                 //get the file

     Progress.SetProgressText(Format('Writing File %d of %d',
                                     [i + 1, Count]));
     Progress.SetProcessText(FileD.InternalFileName);

     //get name and path of file to save to and do it
     FileD.Lines.SaveToFile(FDestPath +
                            GetFilePathName(FileD.FilePath, MinPath));

     Progress.StepProgress;
    end;
  end;



 Progress.Reset;
 Progress.SetWorkText('Finished writing files!');
 Progress.SetProgressText('Finished!');
 Progress.SetProcessText('');
 Progress.SetMaximum(1);
 Progress.StepProgress;

 Result := True;
end;






initialization
{$IFOPT C+}
 TExtractSourceDoc.Create.Destroy;     //generate warning, if class is abstract
{$ENDIF}
 AddGeneratorClass(TExtractSourceDoc); //register generator class

end.