source: trunk/StudioModules/LDModuleProject/UProject.pas

unit UProject;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Dialogs, DOM, XMLWrite, XMLRead, FileUtil,
  SpecializedList, USource;

const
  ProjectExt = '.tppr';

type
  TProject = class;

  TProjectPackage = class
    Name: string;
  end;

  { TProjectPackageList }

  TProjectPackageList = class(TListObject)
    Parent: TProject;
    procedure Load;
    procedure Save;
    procedure SaveToXMLNode(Node: TDOMNode);
    procedure LoadFromXMLNode(Node: TDOMNode);
  end;

  TProjectBuildConfig = class
    Name: string;
  end;

  TProjectBuildConfigList = class(TListObject)
  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;

  { TProjectFileList }

  TProjectFileList = class(TListObject)
    Parent: TProject;
    procedure DumpFileList(Files: TListString);
    procedure LoadFromList(Files: TListString);
    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(TSource)
  private
    FModified: Boolean;
    FOnChange: TNotifyEvent;
    procedure SetModified(AValue: Boolean);
  public
    FileName: string;
    Files: TProjectFileList;
    Packages: TProjectPackageList;
    BuildConfigs: TProjectBuildConfigList;
    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;

  { TProjectTemplateList }

  TProjectTemplateList = class(TListObject)
    procedure AddTemplate(Template: TProjectTemplate);
  end;

resourcestring
  SNewProject = 'New project';

implementation

{ TProjectTemplateList }

procedure TProjectTemplateList.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
  Description.Free;
  inherited Destroy;
end;

{ TProjectPackageList }

procedure TProjectPackageList.Load;
begin

end;

procedure TProjectPackageList.Save;
begin

end;

procedure TProjectPackageList.SaveToXMLNode(Node: TDOMNode);
begin

end;

procedure TProjectPackageList.LoadFromXMLNode(Node: TDOMNode);
begin

end;

{ TProjectGroup }

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

procedure TProjectFileList.LoadFromList(Files: TListString);
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 TProjectFileList.Load;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TProjectFile(Items[I]).Load;
end;

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

procedure TProjectFileList.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 TProjectFileList.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 TProjectFileList.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 TProjectFileList.AddFile(FileName: string): TProjectFile;
begin
  Result := TProjectFile(AddNew(TProjectFile.Create));
  Result.Parent := Parent;
  Result.FileName := FileName;
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
  Source.Free;
  inherited Destroy;
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 FileExistsUTF8(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 := TProjectFileList.Create;
  Files.Parent := Self;
  Packages := TProjectPackageList.Create;
  Packages.Parent := Self;
end;

destructor TProject.Destroy;
begin
  Files.Free;
  Packages.Free;
  BuildConfigs.Free;
  inherited Destroy;
end;

end.