source: trunk/IDE/Project.pas

unit Project;

interface

uses
  Classes, SysUtils, Dialogs, DOM, XMLWrite, XMLRead, FileUtil,
  Generics.Collections;

const
  ProjectExt = '.tppr';

type
  TProject = class;

  TProjectPackage = class
    Name: string;
  end;

  { TProjectPackages }

  TProjectPackages = class(TObjectList<TProjectPackage>)
    Parent: TProject;
    procedure Load;
    procedure Save;
    procedure SaveToXMLNode(Node: TDOMNode);
    procedure LoadFromXMLNode(Node: TDOMNode);
  end;

  TProjectBuildConfig = class
    Name: string;
  end;

  TProjectBuildConfigs = class(TObjectList<TProjectBuildConfig>)
  end;

  { TProjectFile }

  TProjectFile = class
  private
    FModified: Boolean;
    function GetAbsoluteFileName: string;
    procedure SetModified(const AValue: Boolean);
  public
    FileName: string;
    Source: TStringList;
    Parent: TProject;
    constructor Create;
    destructor Destroy; override;
    procedure SaveToXMLNode(Node: TDOMNode);
    procedure LoadFromXMLNode(Node: TDOMNode);
    procedure Load;
    procedure Save;
    property Modified: Boolean read FModified write SetModified;
    property AbsoluteFileName: string read GetAbsoluteFileName;
  end;

  { TProjectFiles }

  TProjectFiles = class(TObjectList<TProjectFile>)
    Parent: TProject;
    procedure DumpFileList(Files: TStringList);
    procedure LoadFromList(Files: TStringList);
    procedure Load;
    procedure Save;
    procedure SaveToXMLNode(Node: TDOMNode);
    procedure LoadFromXMLNode(Node: TDOMNode);
    function SearchFile(FileName: string): TProjectFile;
    function AddFile(FileName: string): TProjectFile;
  end;

  TProject = class
  private
    FModified: Boolean;
    FOnChange: TNotifyEvent;
    procedure SetModified(AValue: Boolean);
  public
    FileName: string;
    Files: TProjectFiles;
    Packages: TProjectPackages;
    BuildConfigs: TProjectBuildConfigs;
    MainSource: TProjectFile;
    procedure LoadFromFile(FileName: string);
    procedure SaveToFile(FileName: string);
    procedure Load;
    procedure Save;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    property Modified: Boolean read FModified write SetModified;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TProjectTemplate }

  TProjectTemplate = class
    Name: string;
    Description: TStringList;
    IsProject: Boolean;
    procedure InitProject(var Project: TProject); virtual;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  { TProjectTemplates }

  TProjectTemplates = class(TObjectList<TProjectTemplate>)
    procedure AddTemplate(Template: TProjectTemplate);
  end;

resourcestring
  SNewProject = 'New project';


implementation

{ TProjectTemplates }

procedure TProjectTemplates.AddTemplate(Template: TProjectTemplate);
begin
  Add(Template);
end;

{ TProjectTemplate }

procedure TProjectTemplate.InitProject(var Project: TProject);
begin
  Project.FileName := SNewProject;
end;

constructor TProjectTemplate.Create;
begin
  Description := TStringList.Create;
end;

destructor TProjectTemplate.Destroy;
begin
  FreeAndNil(Description);
  inherited;
end;

{ TProjectPackages }

procedure TProjectPackages.Load;
begin
end;

procedure TProjectPackages.Save;
begin
end;

procedure TProjectPackages.SaveToXMLNode(Node: TDOMNode);
begin
end;

procedure TProjectPackages.LoadFromXMLNode(Node: TDOMNode);
begin
end;

{ TProjectGroup }

procedure TProjectFiles.DumpFileList(Files: TStringList);
var
  I: Integer;
begin
  Files.Clear;
  for I := 0 to Count - 1 do
    Files.Add(TProjectFile(Items[I]).AbsoluteFileName);
end;

procedure TProjectFiles.LoadFromList(Files: TStringList);
var
  I: Integer;
  NewFile: TProjectFile;
  FileName: string;
begin
  Clear;
  for I := 0 to Files.Count - 1 do begin
    FileName := Files[I];
    if Copy(FileName, 1, Length(ExtractFileDir(Parent.FileName))) =
      ExtractFileDir(Parent.FileName) then
        System.Delete(FileName, 1, Length(ExtractFileDir(Parent.FileName)) + 1);
    NewFile := AddFile(FileName);
    NewFile.Load;
  end;
end;

procedure TProjectFiles.Load;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TProjectFile(Items[I]).Load;
end;

procedure TProjectFiles.Save;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TProjectFile(Items[I]).Save;
end;

procedure TProjectFiles.SaveToXMLNode(Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  with Node do
  for I := 0 to Count - 1 do begin
    NewNode := OwnerDocument.CreateElement('File');
    TProjectFile(Items[I]).SaveToXMLNode(NewNode);
    AppendChild(NewNode);
  end
end;

procedure TProjectFiles.LoadFromXMLNode(Node: TDOMNode);
var
  NewNode: TDomNode;
  NewFile: TProjectFile;
begin
  NewNode := Node.FirstChild;
  while Assigned(NewNode) do begin
    if NewNode.NodeName = 'File' then begin
      NewFile := TProjectFile.Create;
      NewFile.Parent := Parent;
      NewFile.LoadFromXMLNode(NewNode);
      Add(NewFile);
    end;
    NewNode := NewNode.NextSibling;
  end;
end;

function TProjectFiles.SearchFile(FileName: string): TProjectFile;
var
  I: Integer;
  ParentDir: string;
begin
  ParentDir := ExtractFileDir(Parent.FileName);
  if Copy(FileName, 1, Length(ParentDir)) = ParentDir then
    System.Delete(FileName, 1, Length(ParentDir) + 1);
  I := 0;
  while (I < Count) and (TProjectFile(Items[I]).FileName <> FileName) do Inc(I);
  if I < Count then Result := TProjectFile(Items[I])
    else Result := nil;
end;

function TProjectFiles.AddFile(FileName: string): TProjectFile;
begin
  Result := TProjectFile.Create;
  Result.Parent := Parent;
  Result.FileName := FileName;
  Add(Result);
end;

{ TProjectFile }

procedure TProjectFile.SetModified(const AValue: Boolean);
begin
  if FModified = AValue then Exit;
  FModified := True;
  if AValue then Parent.Modified := True;
end;

function TProjectFile.GetAbsoluteFileName: string;
begin
  Result := ExtractFileDir(Parent.FileName) + DirectorySeparator + FileName;
end;

constructor TProjectFile.Create;
begin
  Source := TStringList.Create;
end;

destructor TProjectFile.Destroy;
begin
  FreeAndNil(Source);
  inherited;
end;

procedure TProjectFile.SaveToXMLNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  with Node do begin
    NewNode := OwnerDocument.CreateElement('FileName');
    NewNode.TextContent := UTF8Decode(FileName);
    AppendChild(NewNode);
  end;
  Save;
end;

procedure TProjectFile.LoadFromXMLNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  with Node do begin
    NewNode := FindNode('FileName');
    if Assigned(NewNode) then
      FileName := UTF8Encode(NewNode.TextContent);
  end;
  if FileExists(AbsoluteFileName) then Load;
end;

procedure TProjectFile.Load;
begin
  Source.LoadFromFile(AbsoluteFileName);
end;

procedure TProjectFile.Save;
begin
  Source.SaveToFile(AbsoluteFileName);
end;

{ TProject }

procedure TProject.SetModified(AValue: Boolean);
begin
  if FModified = AValue then Exit;
  FModified := AValue;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TProject.LoadFromFile(FileName: string);
var
  Doc: TXMLDocument;
  NewNode: TDOMNode;
  NewSubNode: TDOMNode;
  I: Integer;
  Text: string;
  MainSourceName: string;
begin
  try
    Clear;
    Self.FileName := FileName;
    ReadXMLFile(Doc, UTF8Decode(FileName));

    NewNode := Doc.DocumentElement.FindNode('Files');
    if Assigned(NewNode) then
      Files.LoadFromXMLNode(NewNode);

    NewNode := Doc.DocumentElement.FindNode('MainSource');
    if Assigned(NewNode) then begin
      MainSourceName := UTF8Encode(NewNode.TextContent);
      MainSource := Files.SearchFile(MainSourceName);
    end;

    NewNode := Doc.DocumentElement.FindNode('Packages');
    if Assigned(NewNode) then
      Packages.LoadFromXMLNode(NewNode);
  finally
    Doc.Free;
  end;
  FModified := False;
end;

procedure TProject.SaveToFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
  NewNode: TDOMNode;
  NewSubNode: TDOMNode;
  I: Integer;
  Text: string;
begin
  Doc := TXMLDocument.Create;
  Self.FileName := FileName;
  with Doc do try
    RootNode := CreateElement('Project');
    AppendChild(RootNode);
    with RootNode do begin
      NewNode := CreateElement('MainSource');
      if Assigned(MainSource) then
        NewNode.TextContent := UTF8Decode(MainSource.FileName);
      AppendChild(NewNode);

      NewNode := CreateElement('Files');
      Files.SaveToXMLNode(NewNode);
      AppendChild(NewNode);

      NewNode := CreateElement('Packages');
      Packages.SaveToXMLNode(NewNode);
      AppendChild(NewNode);
    end;
    WriteXMLFile(Doc, UTF8Decode(FileName));
  finally
    Free;
  end;
  FModified := False;
end;

procedure TProject.Load;
begin
  Files.Load;
  Packages.Load;
end;

procedure TProject.Save;
var
  I: Integer;
begin
  Files.Save;
  Packages.Save;
  for I := 0 to Files.Count - 1 do
    TProjectFile(Files[I]).Modified := False;
  Modified := False;
end;

procedure TProject.Clear;
begin
  Files.Clear;
  Packages.Clear;
  MainSource := nil;
end;

constructor TProject.Create;
begin
  Files := TProjectFiles.Create;
  Files.Parent := Self;
  Packages := TProjectPackages.Create;
  Packages.Parent := Self;
end;

destructor TProject.Destroy;
begin
  FreeAndNil(Files);
  FreeAndNil(Packages);
  FreeAndNil(BuildConfigs);
  inherited;
end;

end.