root/trunk/Projects.pas

unit Projects;

interface

uses classes, Menus, SourceFiles, SimpleXML;

{ Common configurable project info }
type
    TProjectCfg = class
       optimize     : boolean ;   { -O }
       inlineFn     : boolean ;   { -inline }
       debugVersion : boolean;    { -debug }
       debugSymbols : boolean;    { -g }
       profileHooks : boolean;    { -gt }
       unittests    : boolean;    { -unittest }
       releaseVersion : boolean ; { -release }

       linkerFlags  : TStringList;  { -L... }
       versions     : TStringList;  { -version=... }
       versionNumber : string;

       constructor Create;
       destructor  Free;
       function  ToXml : Node;
       procedure FromXML( xml : Node );
       procedure  CopyTo( other : TProjectCfg );
     end;

{ Main Project class }     
type     
    TProject = class
      parent      : TObject;      { workspace attached to }
      config      : TProjectCfg;  { configuration }
      name        : string;       { title for the project }
      destfilename : string ;     { destination filename }

      filename    : string;       { path to project file project.prx) }
      fullbuild   : boolean ;     { Compile all files each Build }
      enabled     : TStringList;  { enabled versions for build }
      saved       : boolean ;

      basepath    : string;       { root path of project, defaults to project path }
      outPath     : string ;      { object file/exe/lib destination -od<dir> }
      importPaths : TStringList;  { -I... }      
      sources     : TSourceFiles; { list of TSourceFile objects}

      constructor  Create;
      destructor   Free;
      procedure    Save;
      procedure    SaveAs( fname : string );


      { Returns true if the version(specified by index) is active }
      function  CheckVersion( N:Integer) : boolean  ;

      function   ExeName : string;
      function   LibName : string;

      { Adds a file to the project }              
      procedure Add( fname : string );

      { Enables and disables versions }
      procedure EnableVersion( N : Integer );
      procedure DisableVersion( N : Integer );

      { Attempts to find a file, given only its name }
      function FindFilePath( name : string ) : string ;

      { returns the compile options for this project }
      function CompileOptions : string ;

      { returns link options for this project }
      function LinkOptions : string;

      { returns the resulting file of compiling the file passed }
      function GetResultFile( fn : string ) : string;

      { stores all the object files for this project in list }
      function GetObjectFiles( list : TStringList ) : Integer;
    end;


    { Loads a project from a file, returns nil if failure }
    function LoadProject( filename : string ) :TProject;

const
   FileVersion = '002';

implementation

uses SysUtils, Workspaces, MyUtils, FileCtrl, Windows;



function  TProject.ExeName : string;
begin
  result := Path( basepath, destfilename + '.exe' );
end;


function  TProject.LibName : string;
begin
  result := Path( basepath, destfilename + '.lib' );
end;


function TProject.CheckVersion( N : Integer ) : boolean;
var
  I : Integer;
begin
  Result := false;
  if N>= config.versions.Count then Exit;
  I := enabled.IndexOf( config.versions[N] );
  result := ( I>=0 );
end;

procedure TProject.EnableVersion( N : Integer );
begin
  if N>=config.versions.Count then Exit;
  enabled.Add( config.versions[N] );
end;


procedure TProject.DisableVersion( N : Integer );
var
  I : Integer;
begin
  if N>=config.versions.Count then Exit;
  I := enabled.IndexOf( config.versions[N] );
  if I>=0 then enabled.Delete( I );
end;



procedure TProject.Add( fname : string );
begin
  sources.Add( fname );
end;


function LoadProject( filename : string ) :TProject;
var
  xml, tmp  : Node;
  proj   : TProject;
  str,dir : string;
  N : Integer;
begin
  Result := nil;
  if not  FileExists( filename ) then Exit;

  xml := LoadXML( filename );
  if Not Assigned( xml ) then Exit;

  proj := TProject.Create;
  proj.filename := filename;
  dir := ExtractFilePath( filename );

  tmp := xml.FindNode( 'ProjectConfig' );
  if Assigned( tmp ) then
  begin
    proj.config.FromXML( tmp );
  end;

  proj.name:= xml.FindText( 'Name' );
  proj.destfilename := xml.FindText( 'DestFileName' );

  tmp := xml.FindNode( 'BasePath' );
  if not Assigned(tmp ) then proj.basepath := dir
  else proj.basePath:= FullPath( dir, tmp.data );
  
  proj.outPath := xml.FindText('OutputPath' );
  proj.outPath := FullPath( dir, proj.outPath );
  
  str:= xml.FindText('FullBuild' );
  proj.fullbuild := LowerCase(str) = 'true';

  tmp:= xml.FindNode( 'ProjectFiles' );
  if Assigned(tmp) then proj.sources.FromXml( tmp, dir );

  tmp := xml.FindNode( 'ImportPaths' );
  if Assigned(tmp) then
    for N:=0 to tmp.Count-1 do proj.importPaths.Add( FullPath( dir, tmp[N].data ) );

  tmp:= xml.FindNode( 'Enabled' );
  if Assigned( tmp ) then
    for N:=0 to tmp.Count-1 do proj.enabled.Add( tmp[N].data );

  xml.Free;
  Result := proj;
end;


procedure TProject.Save;
begin
  SaveAs( Self.filename );
end;

procedure TProject.SaveAs( fname : string );
var
  xml, tmp : Node;
  N : Integer;
  base : string; // directory of project file
begin
  filename:= fname;
  base := ExtractFilePath( fname );
  SetCurrentDir( base );
  xml := Node.Create( 'Project' );
  xml.Add( 'Name', Self.name );
  xml.Add( 'DestFileName',  destfilename );

  if self.basepath <> base then  xml.Add( 'BasePath', RelativePath( base, basepath ) );
  xml.Add( 'OutputPath', RelativePath( base, outPath ) );
  xml.AddBool( 'FullBuild', fullbuild );
  tmp := xml.Add( 'Enabled' );
  for N:=0 to enabled.Count -1 do
        tmp.Add( 'Version', enabled[N] );

  tmp := xml.Add( 'ImportPaths' );
  for N:=0 to importPaths.Count-1 do
        tmp.Add( 'Path', RelativePath( base, importPaths[N] ));

  xml.AddChild( config.ToXml );
  xml.AddChild( sources.ToXml( base ) );
  SaveXML( xml, fname );
  xml.Free;
  saved:= true;
end;


constructor TProject.Create;
begin
  name := '';
  filename := '';
  destfilename := '';  
  saved := false;
  basepath := '';
  outPath := '';
  config := TProjectCfg.Create;
  importPaths := TStringList.Create;
  sources := TSourceFiles.Create( Self );
  enabled := TStringList.Create;
end;


destructor TProject.Free;
begin
  config.Free;
  sources.Free;
  enabled.Free;
  importPaths.Free;
end;



function TProject.GetResultFile( fn : string ) : string;
var
  dir, name, ext : string;
begin
  Result:= '';
  if (not FileExists( fn )) and FileExists( self.basepath + fn )
  then fn := basepath + fn;

  if not FileExists( fn ) then Exit;

  dir := ExtractFilePath( fn );
  name := ExtractFileName( fn );
  if Pos( ' ', dir )>0 then dir := ExtractShortPathName( dir );
  ext := Lowercase(ExtractFileExt( fn ));

  if ext <> '.d' then Exit ; { unknown result file }

  if not Empty( Self.outPath ) then dir:= self.outPath ;
  name := ChangeFileExt( name, '.obj' );
  result := Path(dir , name );
end;



function TProject.LinkOptions : string;
var
  files : TStringList;
  options : TStringList;

  N : LongInt;
begin
  files := TStringList.Create;
  files.Duplicates := dupIgnore ;
  GetObjectFiles( files );
  files.AddStrings( sources.objfiles );
  files.AddStrings( sources.libfiles );

  MyUtils.GetShortNames( files );

  options := TStringList.Create;  
  if not Empty( destfilename ) then options.Add( '-of' + destfilename )
  else options.Add( '-of' + Self.name );

  with config do begin
    if profileHooks then options.Add( '-gt' );
    if debugSymbols then options.Add( '-g' );
    if releaseVersion then options.Add( '-release' );
  end;

  with config do
  if LinkerFlags.Count > 0 then
  begin
    for N:=0 to LinkerFlags.Count-1 do
        if Pos( '.lib', LowerCase(LinkerFlags[N]) )>0 then
           options.Add( linkerflags[N] )
        else options.Add( '-L' + config.linkerFlags[N] );
  end;
  Result:= Join( files, ' ' ) + ' ' + Join( options, ' ' );
end;

{Build up a command line string for compiling }
function TProject.CompileOptions: string;
var
  cmd : TStringList;
  temp : TStringList;
  ws : TWorkspace;
  N : Integer;
  vsn : LongInt;
begin
  ws := TWorkspace(Self.Parent);
  cmd := TStringList.Create;

  with config do
  begin
    if optimize then cmd.Add( '-O' );
    if inlineFn then cmd.Add( '-inline' );
    if debugVersion then cmd.Add( '-debug' );
    if debugSymbols then cmd.Add( '-g' );
    if profileHooks then cmd.Add( '-gt' );
    if unittests then cmd.Add( '-unittest' );
    if ParseInt( versionNumber, vsn ) then  cmd.Add( '-version=' + versionNumber );
  end;

  for N:=0 to self.enabled.Count-1 do
  begin
    if config.versions.IndexOf( enabled[N] ) >=0 then cmd.add( '-version=' + enabled[N] );
  end;

  temp := TStringList.Create;
  temp.Duplicates := dupIgnore;
  temp.Add( self.basepath );
  temp.AddStrings( importPaths );
  temp.AddStrings( ws.config.paths );

  MyUtils.GetShortPaths( temp );
  cmd.Add( '-I' + Join( temp, ';' ) );
  Result:= Join( cmd, ' ' );
  result:= result + Format( ' -od%s' , [self.outPath]);
end;


function TProject.GetObjectFiles( list : TStringList ) : Integer;
var
  N, Count: Integer;
  str : string;
begin
  Count:= 0;
  with sources do
  for N:= 0 to dfiles.Count-1 do begin
    str := GetResultFile( dfiles[N] );
    if Length( str ) > 0 then begin
      list.Add( str );
      Inc( count );
    end
  end;
  result:= Count;
end;


function SearchPaths( pathlist : TStringList ; name : string ) : string;
var
  path : string;
  N: Integer;
begin
  for N:=0 to pathlist.Count-1 do begin
    path := pathlist[N];
    if FileExists( path + name ) then begin
      Result:= path;
      Exit;
    end;
  end;
  Result := '';
end;


function TProject.FindFilePath( name : string ) : string ;
var
  ws : TWorkspace;
begin
  Result :=  SearchPaths( importPaths , name );
  if Length( Result ) > 0 then Exit;
  if not Assigned( Self.parent ) then Exit;
  ws := TWorkspace(Self.parent);
  Result :=  SearchPaths( ws.config.paths , name );
  Exit;
end;



constructor TProjectCfg.Create;
begin
  optimize := false;
  inlineFn := false;
  debugVersion := false;
  debugSymbols := false;
  profileHooks := false;
  unittests    := false;


  versions := TStringList.Create;
  linkerFlags := TStringList.Create;
end;


destructor TProjectCfg.Free;
begin
  versions.Free;
  linkerFlags.Free;
end;

procedure TProjectCfg.CopyTo( other : TProjectCfg );
begin
  other.optimize := optimize;
  other.inlineFn := inlineFn;
  other.debugVersion := debugVersion;
  other.debugSymbols := debugSymbols;
  other.profileHooks := profileHooks;
  other.unittests := unittests;
  other.linkerFlags.Clear;
  other.linkerFlags.AddStrings( linkerFlags );
  other.versions.Clear;
  other.versions.AddStrings( versions );
  other.versionNumber := versionNumber;
  other.releaseVersion := releaseVersion;
end;





function TProjectCfg.ToXML : Node;
var
  cfg, tmp  : Node;
  N : Integer;
begin
  cfg := Node.Create( 'ProjectConfig' );
  cfg.AddBool( 'Optimize', optimize );
  cfg.AddBool( 'InlineFunctions', inlineFn );
  cfg.AddBool( 'DebugVersion', debugVersion );
  cfg.AddBool( 'DebugSymbols', debugSymbols );
  cfg.AddBool( 'ProfileHooks', profileHooks );
  cfg.AddBool( 'UnitTests', unittests );
  cfg.AddBool( 'ReleaseVersion', releaseVersion );
  cfg.Add( 'VersionNumber', versionNumber );
  tmp:=cfg.Add( 'Versions' );
  for N:=0 to versions.Count-1 do tmp.Add('Version', versions[n] );

  tmp := cfg.Add( 'LinkOptions' );
  for N:=0 to linkerFlags.Count-1 do tmp.Add( 'Option', linkerFlags[N] );
  result:= cfg;

end;


procedure TProjectCfg.FromXml( xml : Node );
var
  tmp : Node;
  N : Integer;
begin
  optimize := xml.FindText( 'Optimize' ) = 'true';
  inlineFn := xml.FindText( 'InlineFunctions' ) = 'true';
  debugVersion := xml.FindText( 'DebugVersion' ) = 'true';
  debugSymbols := xml.FindText( 'DebugSymbols' ) = 'true';
  profileHooks := xml.FindText( 'ProfileHooks' ) = 'true';
  unittests := xml.FindText( 'UnitTests' ) = 'true';
  releaseVersion := xml.FindText( 'ReleaseVersion' ) = 'true';
  versionNumber := xml.FindText( 'VersionNumber' );

  tmp:= xml.FindNode( 'Versions' );
  if Assigned(tmp) then
  begin
    for N:= 0 to tmp.Count-1 do versions.Add( tmp[N].data );
  end;
  //reader.ReadStrings( importPaths );
  tmp:= xml.FindNode( 'LinkOptions' );
  if Assigned(tmp) then
  begin
    for N:= 0 to tmp.Count-1 do linkerFlags.Add( tmp[N].data );
  end;

end;

end.