unit ce_projgroup;
{$I ce_defines.inc}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls, Menus,
  Buttons, dialogs, ComCtrls, StdCtrls,
  ce_widget, ce_common, ce_interfaces, ce_writableComponent, ce_observer,
  ce_nativeproject, ce_dubproject, ce_projutils, ce_sharedres, ce_dsgncontrols,
  ce_dialogs;

type

  TProjectGroup = class;

  //TODO-projectgroups: bug, load a free standing project, load a group that contains a link to the FSP.
  //=> the FSP should be either closed or the lazy loader should trap the FSP

  (**
   * Represents a project in a project group
   *)
  TProjectGroupItem = class(TCollectionItem)
  private
    fFilename: string;
    fProj: ICECommonProject;
    fGroup: TProjectGroup;
  published
    property filename: string read fFilename write fFilename;
  public
    property project: ICECommonProject read fProj;
    procedure lazyLoad;
    destructor destroy; override;
    function absoluteFilename: string;
  end;

  (**
   * Collection that handles several project at once.
   *)
  TProjectGroup = class(TWritableLfmTextComponent, ICEProjectGroup, IFPObserver)
  private
    fProjectIndex: integer;
    fItems: TCollection;
    fModified: boolean;
    fOnChanged: TNotifyEvent;
    fBasePath: string;
    procedure setItems(value: TCollection);
    function getItem(index: integer): TProjectGroupItem;
    procedure doChanged;
    //
    procedure FPOObservedChanged(ASender : TObject; Operation :
      TFPObservedOperation; Data : Pointer);
  protected
    procedure afterLoad; override;
    procedure afterSave; override;
  public
    constructor create(aOwner: TComponent); override;
    destructor destroy; override;
    //
    function singleServiceName: string;
    procedure addProject(aProject: ICECommonProject);
    procedure openGroup(const fname: string);
    procedure saveGroup(const fname: string);
    procedure closeGroup;
    function groupModified: boolean;
    function groupFilename: string;
    function projectCount: integer;
    function getProjectIndex: integer;
    function getProject(ix: Integer): ICECommonProject;
    function findProject(const fname: string): ICECommonProject;
    procedure setProjectIndex(value: Integer);
    //
    function addItem(const fname: string): TProjectGroupItem;
    property item[ix: integer]: TProjectGroupItem read getItem; default;
    property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
  published
    property items: TCollection read fItems write setItems;
    property index: integer read fProjectIndex write setProjectIndex;
  end;

  (**
   * GUI for a project group
   *)

  { TCEProjectGroupWidget }

  TCEProjectGroupWidget = class(TCEWidget, ICEProjectObserver)
    BtnAddProj: TCEToolButton;
    btnAddUnfocused: TSpeedButton;
    btnFreeFocus: TSpeedButton;
    btnMoveDown: TCEToolButton;
    btnMoveUp: TCEToolButton;
    btnRemProj: TCEToolButton;
    lstProj: TListView;
    Panel2: TPanel;
    StaticText1: TStaticText;
    procedure btnAddUnfocusedClick(Sender: TObject);
    procedure btnFreeFocusClick(Sender: TObject);
    procedure BtnAddProjClick(Sender: TObject);
    procedure btnMoveDownClick(Sender: TObject);
    procedure btnMoveUpClick(Sender: TObject);
    procedure btnRemProjClick(Sender: TObject);
    procedure lstProjDblClick(Sender: TObject);
  private
    fPrevProj: ICECommonProject;
    fFreeProj: ICECommonProject;
    fProjSubj: TCEProjectSubject;
    //
    procedure projNew(aProject: ICECommonProject);
    procedure projChanged(aProject: ICECommonProject);
    procedure projClosing(aProject: ICECommonProject);
    procedure projFocused(aProject: ICECommonProject);
    procedure projCompiling(aProject: ICECommonProject);
    procedure projCompiled(aProject: ICECommonProject; success: boolean);
    //
    procedure updateList;
    procedure handleChanged(sender: TObject);
  protected
    procedure DoShow; override;
    procedure setToolBarFlat(value: boolean); override;
  public
    constructor create(aOwner: TCOmponent); override;
    destructor destroy; override;
  end;

implementation
{$R *.lfm}

var
  projectGroup: TProjectGroup;

{$REGION TProjectGroup ---------------------------------------------------------}
constructor TProjectGroup.create(aOwner: TComponent);
begin
  inherited;
  Name := 'projectGroup';
  fItems := TCollection.Create(TProjectGroupItem);
  fItems.FPOAttachObserver(self);
  EntitiesConnector.addSingleService(self);
end;

destructor TProjectGroup.destroy;
begin
  fItems.Clear;
  fItems.Free;
  inherited;
end;

procedure TProjectGroup.setItems(value: TCollection);
begin
  fItems.Assign(value);
end;

function TProjectGroup.getItem(index: integer): TProjectGroupItem;
begin
  exit(TProjectGroupItem(fItems.Items[index]));
end;

procedure TProjectGroup.FPOObservedChanged(ASender: TObject;
  Operation: TFPObservedOperation; Data : Pointer);
begin
  if operation = ooChange then
    fModified := true;
end;

procedure TProjectGroup.doChanged;
begin
  if assigned(fOnChanged) then
    fOnChanged(self);
end;

procedure TProjectGroup.setProjectIndex(value: integer);
begin
  if value < 0 then
    value := 0
  else if value > fItems.Count-1 then
    value := fItems.Count-1;
  if fProjectIndex <> value then
  begin
    fProjectIndex := value;
    fModified := true;
  end;
end;

function TProjectGroup.addItem(const fname: string): TProjectGroupItem;
var
  it: TCollectionItem;
begin
  fModified := true;
  for it in fItems do
  begin
    if SameFileName(TProjectGroupItem(it).absoluteFilename, fname) then
      exit(TProjectGroupItem(it));
  end;
  result := TProjectGroupItem(fItems.Add);
  result.fGroup := self;
  if fBasePath = '' then
    result.fFilename := fname
  else
    result.fFilename := ExtractRelativepath(fBasePath, fname);
end;

function TProjectGroup.getProject(ix: Integer): ICECommonProject;
begin
  item[ix].lazyLoad;
  exit(item[ix].fProj);
end;

function TProjectGroup.findProject(const fname: string): ICECommonProject;
var
  i: integer;
begin
  result := nil;
  for i := 0 to projectCount-1 do
    if SameFileName(item[i].absoluteFilename, fname) then
    begin
      item[i].lazyLoad;
      exit(item[i].fProj);
    end;
end;

procedure TProjectGroup.afterLoad;
var
  p: TProjectGroupItem;
  i: integer;
  b: boolean = false;
  f: string = '';
begin
  inherited;
  for i:= projectCount-1 downto 0 do
  begin
    p := item[i];
    p.fGroup := self;
    if not p.absoluteFilename.fileExists then
    begin
      f += LineEnding + '"' + p.absoluteFilename + '"';
      fItems.Delete(i);
      b := true;
    end;
  end;
  fModified := b;
  if b then
    dlgOkError('the following projects are missing and are removed from the group:' + f,
      'Project group error');
end;

procedure TProjectGroup.afterSave;
begin
  inherited;
  fModified:=false;
end;

procedure TProjectGroup.addProject(aProject: ICECommonProject);
var
  it: TCollectionItem;
begin
  fModified := true;
  for it in fItems do
    if SameFileName(TProjectGroupItem(it).absoluteFilename, aProject.filename) then
      exit;
  it := fItems.Add;
  if fBasePath = '' then
    TProjectGroupItem(it).fFilename := aProject.filename
  else
    TProjectGroupItem(it).fFilename := ExtractRelativepath(fBasePath, aProject.filename);
  TProjectGroupItem(it).fProj := aProject;
  TProjectGroupItem(it).fGroup := self;
  aProject.inGroup(true);
  fProjectIndex := it.Index;
  doChanged;
end;

procedure TProjectGroup.openGroup(const fname: string);
var
  i: integer;
begin
  fBasePath := fname.extractFilePath;
  loadFromFile(fname);
  for i:= 0 to fItems.Count-1 do
    getItem(i).fGroup := self;
  doChanged;
end;

procedure TProjectGroup.saveGroup(const fname: string);
var
  i: integer;
  c: boolean = false;
  n: string;
begin
  n := fname.extractFilePath;
  if (fBasePath <> '') and (n <> fBasePath) then
  begin
    c := true;
    for i:= 0 to projectCount-1 do
      getItem(i).fFilename := getItem(i).absoluteFilename;
  end
  else if fBasePath = '' then
    c := true;
  if c then for i:= 0 to projectCount-1 do
    getItem(i).fFilename := ExtractRelativepath(n, getItem(i).fFilename);
  fBasePath := n;
  saveToFile(fname);
end;

procedure TProjectGroup.closeGroup;
begin
  fItems.Clear;
  fBasePath:='';
  fFilename:= '';
  fModified:=false;
  fProjectIndex := -1;
  doChanged;
end;

function TProjectGroup.groupModified: boolean;
var
  i: integer;
  b: boolean = false;
begin
  for i:= 0 to fItems.Count-1 do
    if (getItem(i).fProj <> nil) and getItem(i).fProj.modified then
    begin
      b := true;
      break;
    end;
  exit(fModified or b);
end;

function TProjectGroup.groupFilename: string;
begin
  exit(Filename);
end;

function TProjectGroup.projectCount: integer;
begin
  exit(fItems.Count);
end;

function TProjectGroup.getProjectIndex: integer;
begin
  exit(fProjectIndex);
end;

function TProjectGroup.singleServiceName: string;
begin
  exit('ICEProjectGroup');
end;

procedure TProjectGroupItem.lazyLoad;
begin
  if fProj = nil then
  begin
    fProj := loadProject(absoluteFilename, true);
    fProj.inGroup(true);
  end;
end;

destructor TProjectGroupItem.destroy;
begin
  if fProj <> nil then
    fProj.getProject.free;
  fProj := nil;
  inherited;
end;

function TProjectGroupItem.absoluteFilename: string;
begin
  if fGroup.fBasePath = '' then
    result := fFilename
  else
    result := expandFilenameEx(fGroup.fBasePath, fFilename);
end;
{$ENDREGION}

{$REGION Widget Standard component things --------------------------------------}
constructor TCEProjectGroupWidget.create(aOwner: TCOmponent);
begin
  inherited;
  AssignPng(btnFreeFocus, 'PENCIL');
  AssignPng(btnAddUnfocused, 'DOCUMENT_ADD');
  projectGroup.onChanged:= @handleChanged;
  fProjSubj:= TCEProjectSubject.Create;
end;

destructor TCEProjectGroupWidget.destroy;
begin
  fProjSubj.free;
  inherited;
end;

procedure TCEProjectGroupWidget.DoShow;
begin
  inherited;
  updateList;
end;

procedure TCEProjectGroupWidget.setToolBarFlat(value: boolean);
begin
  inherited setToolBarFlat(value);
  btnFreeFocus.flat := value;
  btnAddUnfocused.flat := value;
end;
{$ENDREGION}

{$REGION Widget ICEProjectObserver ---------------------------------------------}
procedure TCEProjectGroupWidget.projNew(aProject: ICECommonProject);
begin
  fPrevProj := aProject;
  if not aProject.inGroup then
    fFreeProj := aProject;
end;

procedure TCEProjectGroupWidget.projChanged(aProject: ICECommonProject);
begin
  updateList;
end;

procedure TCEProjectGroupWidget.projClosing(aProject: ICECommonProject);
begin
  fPrevProj := nil;
  if aProject = fFreeProj then
  begin
    fFreeProj := nil;
    updateList;
  end;
end;

procedure TCEProjectGroupWidget.projFocused(aProject: ICECommonProject);
begin
  fPrevProj := aProject;
  if not aProject.inGroup then
  begin
    fFreeProj := aProject;
    updateList;
  end
  else if (aProject = fFreeProj) and (aProject.inGroup) then
  begin
    fFreeProj := nil;
    updateList;
  end;
end;

procedure TCEProjectGroupWidget.projCompiling(aProject: ICECommonProject);
begin
end;

procedure TCEProjectGroupWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}

{$REGION Widget project group things -------------------------------------------}
procedure TCEProjectGroupWidget.BtnAddProjClick(Sender: TObject);
var
  fname: string;
  added: boolean;
begin
  with TOpenDialog.Create(nil) do
  try
    Options:= [ofAllowMultiSelect, ofEnableSizing];
    if not execute then
      exit;
    for fname in Files do
    begin
      if projectGroup.findProject(fname) <> nil then
        continue;
      projectGroup.addItem(fname);
      added := true;
    end;
    if added then
      updateList;
  finally
    free;
  end;
end;

procedure TCEProjectGroupWidget.btnFreeFocusClick(Sender: TObject);
begin
  if fFreeProj <> nil then
    subjProjFocused(fProjSubj, fFreeProj);
end;

procedure TCEProjectGroupWidget.btnAddUnfocusedClick(Sender: TObject);
begin
  if fFreeProj = nil then
    exit;
  projectGroup.addProject(fFreeProj);
  fFreeProj := nil;
  updateList;
end;

procedure TCEProjectGroupWidget.btnMoveDownClick(Sender: TObject);
begin
  if lstProj.ItemIndex = -1 then exit;
  if lstProj.ItemIndex = lstProj.Items.Count-1 then exit;
  //
  projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1);
  lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1);
  projectGroup.index:=projectGroup.index+1;
  lstProj.ItemIndex:=lstProj.ItemIndex+1;
end;

procedure TCEProjectGroupWidget.btnMoveUpClick(Sender: TObject);
begin
  if lstProj.ItemIndex = -1 then exit;
  if lstProj.ItemIndex = 0 then exit;
  //
  projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1);
  lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1);
  projectGroup.index:=projectGroup.index-1;
  lstProj.ItemIndex:=lstProj.ItemIndex-1;
end;

procedure TCEProjectGroupWidget.btnRemProjClick(Sender: TObject);
begin
  if lstProj.ItemIndex = -1 then exit;
  projectGroup.items.Delete(lstProj.Selected.Index);
  updateList;
end;

procedure TCEProjectGroupWidget.lstProjDblClick(Sender: TObject);
begin
  if lstProj.ItemIndex = -1 then
    exit;
  TProjectGroupItem(lstProj.Selected.Data).lazyLoad;
  subjProjFocused(fProjSubj, TProjectGroupItem(lstProj.Selected.Data).project);
  if projectGroup.getProjectIndex <> lstProj.ItemIndex then
    projectGroup.setProjectIndex(lstProj.ItemIndex);
end;

procedure TCEProjectGroupWidget.handleChanged(sender: TObject);
begin
  updateList;
  if (projectGroup.getProjectIndex <> -1) and (projectGroup.getProjectIndex <> lstProj.ItemIndex) then
  begin
    lstProj.ItemIndex := projectGroup.getProjectIndex;
    lstProjDblClick(nil);
  end;
end;

procedure TCEProjectGroupWidget.updateList;
var
  i: integer;
  p: TProjectGroupItem;
const
  typeStr: array[TCEProjectFormat] of string = ('CE','DUB');
begin
  lstProj.Clear;
  for i := 0 to projectGroup.projectCount-1 do
  begin
    with lstProj.Items.Add do
    begin
      p := projectGroup.item[i];
      p.fGroup := projectGroup;
      p.lazyLoad;
      Data:= p;
      case p.project.getFormat of
        pfNative: Caption := p.fFilename.extractFileName;
        pfDub: Caption := TCEDubProject(p.project.getProject).packageName;
      end;
      SubItems.Add(typeStr[p.fProj.getFormat]);
      SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex));
    end;
  end;
  if fFreeProj <> nil then
  begin
    case fFreeProj.getFormat of
      pfNative: StaticText1.Caption:= 'Free standing: ' + fFreeProj.filename.extractFileName;
      pfDub: StaticText1.Caption:= 'Free standing: ' + TCEDubProject(fFreeProj.getProject).packageName;
    end;
  end
  else
    StaticText1.Caption:= 'No free standing project';
end;
{$ENDREGION}

initialization
  projectGroup := TProjectGroup.create(nil);
finalization
  projectGroup.Free;
end.