root/trunk/Workspaces.pas

unit Workspaces;

{ Workspace classes }

interface
uses classes, Projects, SimpleXML;

{ Configuration options for a Workspace }
type
     TWorkspaceCfg = class
       compiler       : string; { location of the dmd compiler }
       linker         : string; { location of the linker }
       sourceEditor   : string; { location of the source editor }
       editorCommand  : string; { command string for invoking source editor }
       paths          : TStringList;

       constructor Create;
       destructor  Free;

       procedure CopyTo( other : TWorkspaceCfg );

       function toXML : Node;
       procedure fromXML( xml : Node );
     end;


{ Main Workspace class }     
type
    TWorkspace = class
      name      : string;         { onscreen title of the workspace }
      filename  : string;         { filename to save workspace to }
      output    : TStringList;    { results from compile/build }
      projects  : TList;
      failed    : TStringList;    { projects which failed to load }
      config    : TWorkspaceCfg;

      function Saved     : boolean; 

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

      { Add a project to this workspace }
      procedure Add( proj :TProject );

      { Invoke the source editor for the passed file }
      procedure EditFile( fname : string ; LN:Integer );

      { Invoke the compiler for the passed project and file }      
      function CompileFile( proj:TProject; fname : string ) : boolean;

      { Conditionally invoke the compiler using the current FullBuild option }
      function BuildFile( proj:TProject; fname : string ) : boolean;

      { Build all files in the passed project }
      function BuildAll( p : TProject ) : boolean;

      { Build an EXE file for the passed project }      
      function BuildProjectEXE( p : TProject ) : boolean;

      { Build a LIB file for the passed project }
      function BuildProjectLIB( p : TProject ) : boolean;

      { Find a project based on passed name }
      function  FindProject( filename : string ) : TProject;

      protected
      { Generates a command line string for editing a source file }
      function GetEditString( fname:string; LN : Integer ) : string ;      
    end;

    { Loads a workspace file, returns nil if could not load }
    function LoadWorkspace( fname : string ) :TWorkspace ;

const
   FileVersion = '001';


implementation

uses UMain, SysUtils, MyUtils, Windows, FileCtrl, Clipbrd;


function TWorkspace.GetEditString( fname:string; LN: INteger ) : string ;
var
  line, lcline : string;
begin
  Result := '';
  line := Trim(self.config.editorCommand) ;
  if Empty( line ) then line:='$file /L:$Line';

  lcline := LowerCase( line );
  if Pos( '$file', lcline )<1 then line := '$file ' + line; 

  line:= StringReplace( line, '$file', fname, [rfReplaceAll,rfIgnoreCase] );
  if LN>0 then
    line:=StringReplace( line, '$line', Format( '%d', [LN] ), [rfReplaceAll,rfIgnoreCase] )
  else
    line:=StringReplace( line, '$line', Format( '%s', [''] ), [rfReplaceAll,rfIgnoreCase] );
  Result := line;
end;



{Invoke Editor}
procedure TWorkspace.EditFile( fname : string ; LN : Integer );
var
  args : TStringList;
  argstring : string;
  editor : string;
begin
  editor := Path( config.sourceEditor );
  
  args := TStringList.Create;

  if Pos( ' ', fname )>0 then fname:= '"' + fname + '"';

  if LN>=0 then
    args.add( GetEditString(fname,LN) )
  else
    args.add( fname );
  argstring := Join( args, ' ');
  args.Free;  
  Clipboard.SetTextBuf( PChar( argstring ) );
  Win32Exec( config.sourceEditor, argstring );
end;




{ Compiles a source file, true if compilation was successful }
function TWorkspace.CompileFile( proj: TProject ; fname : string  ) : boolean;
var
  cmd, dest : string;
  qname : string;
begin
  result := false;
  output.Clear;
  proj.sources.ClearErrors( fname );  
  if not DirectoryExists( proj.basepath ) then Exit;
  SetCurrentDir( proj.basepath );
  if not FileExists(fname) then Exit;

  qname:= ShortName( fname );

  cmd := Format( '-c %s %s', [ qname, proj.CompileOptions ] );
  dest := proj.outPath;
  if not DirectoryExists( dest ) then begin
    output.Add( 'Output Directory does not exist!');
    Exit;
  end;

  Sysutils.SetCurrentDir( proj.basepath );

  { copy command line string to clipboard }
  Clipboard.SetTextBuf( PChar( config.compiler + ' ' + cmd ) );
  ConsoleApp( config.compiler, cmd, output );
  TrimAll( output );

  if output.count > 0 then proj.sources.AddErrors( fname , output );
  Result:= ( output.Count = 0 );
  Exit;
end;


function TWorkspace.BuildFile( proj:TProject; fname : string ) : boolean;
var
  outname : string;
  otime, stime : Integer; { obj time, source time }
begin
  outname := proj.GetResultFile( fname );
  proj.sources.ClearErrors( fname );
  if (not proj.fullbuild) and FileExists(outname) then
  begin
    stime := FileAge( fname );
    otime := FileAge( proj.GetResultFile( fname ) );
    if otime >= stime then begin
      result:= true;
      Exit;
    end; 
  end;
  result:= CompileFile( proj, fname ); 
end;


function TWorkspace.BuildAll( p : TProject ) : boolean;
var
  N : Integer;
begin
  Result:= false;
  with p.sources do
    for N:= 0 to dfiles.Count-1 do
      if not BuildFile( p, dfiles[N] ) then  Exit;

  Result:=true;
end;


function TWorkspace.BuildProjectEXE( p : TProject ) : boolean;
var
  outfiles : TStringList;
  linkcmd : string;
begin
  Result:=FileExists( self.config.compiler);
  if not Result then Exit;

  output.Clear;
  Result := Self.BuildAll( p );
  if not Result then Exit;

  outfiles := TStringList.Create;
  outfiles.Duplicates := dupIgnore;
  p.GetObjectFiles( outfiles );
  outfiles.AddStrings( p.sources.objfiles );
  outfiles.AddStrings( p.sources.libfiles );

  MyUtils.GetShortNames( outfiles );

  linkcmd := Format( '%s %s',
                     [ p.LinkOptions, Join( outfiles, ' ') ] );
  ClipBoard.SetTextBuf( PChar( linkcmd ) );
  SetCurrentDir( p.basepath );
  ConsoleApp( config.compiler, linkcmd, output ) ;
  result:= true;
end;



function TWorkspace.BuildProjectLIB( p : TProject ) : boolean;
var
  outfiles : TStringList;
  libcmd : string;
  libfile : string;
  N : Integer;
begin
  Result:=FileExists( self.config.compiler);
  if not Result then Exit;

  output.Clear;
  Result := Self.BuildAll( p );
  if not Result then Exit;

  outfiles := TStringList.Create;
  p.GetObjectFiles( outfiles );
  outfiles.AddStrings( p.sources.objfiles );
  outfiles.AddStrings( p.sources.libfiles );

  GetShortNames( outfiles );
  libfile := p.LibName;

  N := outfiles.IndexOf( libfile );
  if N>=0 then  outfiles.Delete( N );

  libfile := ShortName( libfile );

  SetCurrentDir( p.basepath );

  libcmd := Format( '-c %s %s', [ libfile, Join( outfiles, ' ' ) ] ); 
  ClipBoard.SetTextBuf( PChar( libcmd ) );
  ConsoleApp( 'lib.exe', libcmd, output ) ;
  TrimAll( output );
  outfiles.Free;
  result:= true;
end;



constructor TWorkspace.Create;
begin
  filename :='';
  name := '';
  output   := TStringList.Create;
  projects := TList.Create;
  failed   := TStringList.Create;
  config   := TWorkspaceCfg.Create;
end;


destructor TWorkspace.Free;
var
  N : LongInt;
  proj : TProject;
begin
  for N:= 0 to projects.Count-1 do begin
    proj := projects[N];
    proj.Free;
  end;
  output.Free;  
  projects.Free;
  failed.Free;
  config.Free;
end;


function TWorkspace.Saved : boolean;
begin
  Result:= ( not Empty(filename) ) and FileExists( filename );
end;

procedure TWorkspace.Add( proj: TProject );
begin
  if not Assigned( proj ) then Exit;
  proj.parent := Self ;
  projects.Add( proj );
end;


function LoadWorkspace( fname : string ) : TWorkspace;
var
   xml, tmp, cfg : Node;
   N : LongInt;
   proj : TProject;
   str : string;
begin
   Result := nil;

   if not FileExists( fname ) then exit;

   xml := LoadXML( fname );
   if not Assigned(xml) then Exit;

   result := TWorkspace.Create ;
   result.filename := fname;

   result.name := xml.FindText( 'Name' );

   cfg := xml.FindNode( 'WorkspaceConfig' );
   result.config.fromXML( cfg );

   tmp := xml.FindNode( 'Projects' );
   for N:=0 to tmp.Count-1 do begin
     str := tmp[N].data;
     proj := LoadProject( str );
     if Assigned( proj ) then result.Add( proj )
     else result.failed.Add( str );
   end;

   xml.Free;
end;

procedure TWorkspace.Save;
begin
  if not Empty( self.filename ) then Self.SaveAs( self.filename );
end;

procedure TWorkspace.SaveAs( fname : string );
var
  xml, prj, tmp : Node;
  I : LongInt;
  proj : TProject;
begin
  filename := fname;

  xml:=Node.Create( 'Workspace' );
  tmp:=xml.Add( 'Name' );
  tmp.data := self.name;

  xml.AddChild( config.toXML );
  prj := xml.Add( 'Projects' );

  for I:= 0 to projects.Count-1 do begin
    proj := projects[I];
    tmp := prj.Add( 'Filename' );
    tmp.data := proj.filename;
  end;

  SaveXML( xml, filename );
  xml.Free;
end;


function TWorkspace.FindProject( filename : string ) : TProject;
var
  proj : TProject;
  pname : string;
  N : integer;
begin
  Result := nil;
  pname := Trim( ExtractFileName( filename ));
  pname := ChangeFileExt( pname, '' );
  for N:=0 to projects.Count-1 do begin
    proj := projects[ N ];
    if proj.filename = filename then
    begin
      Result:= proj;
      Exit;
    end;
  end;
end;


constructor TWorkspaceCfg.Create;
begin
  compiler := '';
  sourceEditor := '';
  editorCommand := '';
  paths := TStringList.Create;
end;


destructor TWorkspaceCfg.Free;
begin
  paths.Free;
end;

function TWorkspaceCfg.toXML : Node;
var
  cfg, tmp : Node;
begin
  cfg:= Node.Create( 'WorkspaceConfig' );
  tmp := cfg.Add( 'Compiler' );
  tmp.data := self.compiler;

  tmp := cfg.Add( 'Linker' );
  tmp.data := self.linker;

  tmp := cfg.Add( 'Editor' );
  tmp.data := self.sourceEditor;

  tmp := cfg.Add( 'EditCommand' );
  tmp.data := self.editorCommand;
  result:= cfg;
end;


procedure TWorkspaceCfg.fromXML( xml : Node );
begin
  if not Assigned(xml) then Exit;
  self.Compiler := xml.FindText( 'Compiler' );
  self.linker := xml.FindText( 'Linker' );
  self.sourceEditor := xml.FindText( 'Editor' );
  self.editorCommand := xml.FindText( 'EditCommand' );
end;



procedure TWorkspaceCfg.CopyTo( other : TWorkspaceCfg );
begin
  other.compiler := compiler;
  other.linker := linker;
  other.sourceEditor := sourceEditor;
  other.editorCommand := editorCommand;
  other.paths.Clear;
  other.paths.AddStrings( paths );
end;

{
procedure TWorkspaceCfg.Save( writer:TDataWriter );
begin
  writer.WriteString( compiler );
  writer.WriteString( linker );
  writer.WriteString( sourceEditor );
  writer.WriteString( editorCommand );
  writer.WriteStrings( paths );
end;


procedure TWorkspaceCfg.Load( reader : TDataReader );
begin
  reader.ReadString( compiler );
  reader.ReadString( linker );
  reader.ReadString( sourceEditor );
  reader.ReadString( editorCommand );
  reader.ReadStrings( paths );
end;
}

end.