path: root/examples/apps/ide/src/project.pas

unit Project;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, UnitList, fpg_base, fpg_iniutils;

type
  TBooleanGrid = array of array of Boolean;

  TProject = class(TObject)
  private
    FMakeOptionsGrid: TBooleanGrid;
    FProjectName: TfpgString;
    FMainUnit: TfpgString;
    FUnitDirs: TStringList;
    FUnitDirsGrid: TBooleanGrid;
    FUnitList: TUnitList;
    FIniFile: TfpgINIFile;
    FProjectDir: TfpgString;
    FTargetFile: TfpgString;
    FDefaultMake: integer;
    FMakeOptions: TStringList;
    FMacroNames: TStringList;
    FUnitOutputDir: TfpgString;
    procedure   MergeWithGlobalMacros;
  public
    constructor Create;
    destructor  Destroy; override;
    function    Save(const AFile: TfpgString = ''): Boolean;
    function    Load(AProjectFile: TfpgString): Boolean;
    function    GenerateCmdLine(const AShowOnly: Boolean = False; const ABuildMode: integer = -1): TfpgString;
    procedure   ClearAndInitMakeOptions(const ASize: integer);
    procedure   ClearAndInitUnitDirsGrid(const ASize: integer);
    procedure   ClearAndInitMacrosGrid(const ASize: integer);
    property    ProjectDir: TfpgString read FProjectDir write FProjectDir;
    property    ProjectName: TfpgString read FProjectName write FProjectName;
    property    MainUnit: TfpgString read FMainUnit write FMainUnit;
    property    TargetFile: TfpgString read FTargetFile write FTargetFile;
    property    UnitList: TUnitList read FUnitList;
    property    DefaultMake: integer read FDefaultMake write FDefaultMake;
    property    MakeOptions: TStringList read FMakeOptions;
    property    MakeOptionsGrid: TBooleanGrid read FMakeOptionsGrid write FMakeOptionsGrid;
    property    MacroNames: TStringList read FMacroNames;
    property    UnitDirs: TStringList read FUnitDirs;
    property    UnitOutputDir: TfpgString read FUnitOutputDir write FUnitOutputDir;
    property    UnitDirsGrid: TBooleanGrid read FUnitDirsGrid write FUnitDirsGrid;
  end;


// lazy-mans singleton
function GProject: TProject;

procedure FreeProject;


implementation

uses
  ideconst
  ,ideutils
  ,fpg_utils
  ,idemacros
  ;


var
  uProject: TProject;

function GProject: TProject;
begin
  if not Assigned(uProject) then
    uProject := TProject.Create;
  Result := uProject;
end;

procedure FreeProject;
begin
  uProject.Free;
  uProject := nil;
end;


{ TProject }

procedure TProject.MergeWithGlobalMacros;
var
  o: TIDEMacro;
  i: integer;
  n,v: TfpgString;
begin
  for i := 0 to MacroNames.Count-1 do
  begin
    MacroNames.GetNameValue(i, n, v);
    o := TIDEMacro.Create(cMacroPrefix + n + cMacroSuffix, v, '');
    GMacroList.Add(o);
  end;
end;

constructor TProject.Create;
begin
  inherited Create;
  FUnitList := TUnitList.Create;
  FMakeOptions := TStringList.Create;
  FMacroNames := TStringList.Create;
  FUnitDirs := TStringList.Create;
end;

destructor TProject.Destroy;
begin
  FUnitDirs.Free;
  FMacroNames.Free;
  FMakeOptions.Free;
  FUnitList.Free;
  FIniFile.Free;
  inherited Destroy;
end;

function TProject.Save(const AFile: TfpgString = ''): Boolean;
var
  c, j: integer;
  s: TfpgString;
  lDelim: TfpgString;

  procedure SaveList(AList: TStringList; const CName, IName: TfpgString);
  var
    i: integer;
  begin
    FIniFile.WriteInteger(cProjectOptions, CName, AList.Count);
    for i := 0 to AList.Count-1 do
      FIniFile.WriteString(cProjectOptions, IName + IntToStr(i+1), AList[i]);
  end;

begin
  Result := False;
  if (AFile = '') and (ProjectName = '') then
    raise Exception.Create('Project name has not been specified yet');

  if not Assigned(FIniFile) then
  begin
    if AFile = '' then
      FIniFile := TfpgINIFile.CreateExt(ProjectDir + ProjectName + cProjectExt)
    else
      FIniFile := TfpgINIFile.CreateExt(AFile);
  end
  else
  begin
    if AFile <> '' then
    begin
      FIniFile.Free;
      FIniFile := TfpgINIFile.CreateExt(AFile);
    end;
  end;

  if AFile <> '' then
    ProjectName := fpgExtractFileName(AFile);

  FIniFile.WriteString(cProjectOptions, 'ProjectName', ProjectName);
  FIniFile.WriteString(cProjectOptions, 'MainUnit', MainUnit);
  FIniFile.WriteString(cProjectOptions, 'TargetFile', TargetFile);
  FIniFile.WriteInteger(cProjectOptions, 'DefaultMake', DefaultMake);
  FIniFile.WriteString(cProjectOptions, 'UnitOutputDir', UnitOutputDir);

  // Process the Make (compiler param) options
  { first delete old items in ini file }
  c := FIniFile.ReadInteger(cProjectOptions, 'MakeOptionsCount', 0);
  for j := 1 to c do
    FIniFile.DeleteKey(cProjectOptions, cINIMakeOption + IntToStr(j));
  { no lets save new info }
  SaveList(MakeOptions, 'MakeOptionsCount', cINIMakeOption);
  for j := 0 to MakeOptions.Count-1 do
  begin
    s := '';
    lDelim := '';
    for c := 0 to 5 do
    begin
      if MakeOptionsGrid[c, j] then  // True = 1, False = 0
        s := s + lDelim + '1'
      else
        s := s + lDelim + '0';
      lDelim := ',';
    end;
    FIniFile.WriteString(cProjectOptions, cINIMakeOptionGrid + IntToStr(j+1), s);
  end;

  // macros definitions
  SaveList(MacroNames, 'MacroCount', 'Macro');

  // unit search directories
  { first delete old items in ini file }
  c := FIniFile.ReadInteger(cProjectOptions, 'UnitDirsCount', 0);
  for j := 1 to c do
    FIniFile.DeleteKey(cProjectOptions, cINIUnitDir + IntToStr(j));
  SaveList(UnitDirs, 'UnitDirsCount', cINIUnitDir);
  for j := 0 to UnitDirs.Count-1 do
  begin
    s := '';
    lDelim := '';
    for c := 0 to 9 do
    begin
      if UnitDirsGrid[c, j] then  // True = 1, False = 0
        s := s + lDelim + '1'
      else
        s := s + lDelim + '0';
      lDelim := ',';
    end;
    FIniFile.WriteString(cProjectOptions, cINIUnitDirGrid + IntToStr(j+1), s);
  end;

  // Unit file list
  FIniFile.WriteInteger(cUnits, 'UnitCount', UnitList.Count);
  for j := 0 to UnitList.Count-1 do
  begin
    s := UnitList[j].FileName;
    FIniFile.WriteString(cUnits, 'Unit' + IntToStr(j+1),
        Format('%s,%s', [ExtractRelativepath(ProjectDir, s), BoolToStr(UnitList[j].Opened, False)]));
  end;

  Result := True;
end;

function TProject.Load(AProjectFile: TfpgString): Boolean;
var
  a: string;
  s: TfpgString;
  j: integer;
  l: integer;
  sl: TStringList;
  u: TUnit;

  // CName = xxxCount & IName is the Item name
  procedure LoadList(ASection: TfpgString; AList: TStringList; const CName, IName: TfpgString);
  var
    c: integer;
    i: integer;
  begin
    c := FIniFile.ReadInteger(ASection, CName, 0);
    for i := 0 to c-1 do
    begin
      s := FIniFile.ReadString(ASection, IName + IntToStr(i+1), '');
      if s <> '' then
        AList.Add(s);
    end;
  end;

begin
  Result := False;
  if AProjectFile = '' then
    raise Exception.Create('You need to specify a Project filename');

  if not Assigned(FIniFile) then
    FIniFile := TfpgINIFile.CreateExt(AProjectFile);

  ProjectDir := fpgExtractFilePath(AProjectFile);
  ProjectName := FIniFile.ReadString(cProjectOptions, 'ProjectName', fpgChangeFileExt(fpgExtractFileName(AProjectFile), ''));
  MainUnit := FIniFile.ReadString(cProjectOptions, 'MainUnit', '');
  TargetFile := FIniFile.ReadString(cProjectOptions, 'TargetFile', '');
  DefaultMake := FIniFile.ReadInteger(cProjectOptions, 'DefaultMake', 0);
  UnitOutputDir := FIniFile.ReadString(cProjectOptions, 'UnitOutputDir', 'units/'+cMacro_Target+'/');

  // Load make options
  LoadList(cProjectOptions, MakeOptions, 'MakeOptionsCount', 'MakeOption');
  sl := TStringList.Create;
  try
    LoadList(cProjectOptions, sl, 'MakeOptionsCount', cINIMakeOptionGrid);
    SetLength(FMakeOptionsGrid, 6, MakeOptions.Count);    // 6 columns by X rows
    for j := 0 to sl.Count-1 do
    begin
      s := sl[j];
      for l := 0 to 5 do  // we know we only have 6 columns
      begin
        a := tiToken(s, ',', l+1);
        MakeOptionsGrid[l, j] := Boolean(StrToInt(a));  // 1 = True, 0 = False
      end;
    end;
  finally
    sl.Free;
  end;

  // Load Macro definitions
  LoadList(cProjectOptions, MacroNames, 'MacroCount', 'Macro');
  if MacroNames.Count > 0 then
    GMacroList.ResetToDefaults;
  MergeWithGlobalMacros;

  // Load Unit search dirs
  LoadList(cProjectOptions, UnitDirs, 'UnitDirsCount', 'UnitDir');
  sl := TStringList.Create;
  try
    LoadList(cProjectOptions, sl, 'UnitDirsCount', 'UnitDirEnabled');
    SetLength(FUnitDirsGrid, 10, UnitDirs.Count);    // 10 columns by X rows
    for j := 0 to sl.Count-1 do
    begin
      s := sl[j];
      for l := 0 to 9 do  // we know we only have 10 columns
      begin
        a := tiToken(s, ',', l+1);
        UnitDirsGrid[l, j] := Boolean(StrToInt(a));  // 1 = True, 0 = False
      end;
    end;
  finally
    sl.Free;
  end;

  // Load Unit file list
  sl := TStringList.Create;
  try
    LoadList(cUnits, sl, 'UnitCount', 'Unit');
    for j := 0 to sl.Count-1 do
    begin
      u := TUnit.Create;
      s := tiToken(sl[j], ',', 1);
      u.FileName := fpgExpandFileName(ProjectDir + s);
      u.Opened := Boolean(StrToInt(tiToken(sl[j], ',', 2)));  // 1 = True, 0 = False
      UnitList.Add(u);
    end;
  finally
    sl.Free;
  end;

  Result := True;
end;

function TProject.GenerateCmdLine(const AShowOnly: Boolean; const ABuildMode: integer): TfpgString;
var
  c: TfpgString;
  b: integer;
  eol: TfpgString;
  i: integer;
begin
  if AShowOnly then
    eol := LineEnding
  else
    eol := '';
  if ABuildMode = -1 then
    b := DefaultMake
  else
    b := ABuildMode;

  // include dirs
  for i := 0 to UnitDirs.Count-1 do
    if UnitDirsGrid[b, i] and UnitDirsGrid[7, i] then
      c := c + ' -Fi' + UnitDirs[i] + eol;
  // unit dirs
  for i := 0 to UnitDirs.Count-1 do
    if UnitDirsGrid[b, i] and UnitDirsGrid[6, i] then
      c := c + ' -Fu' + UnitDirs[i] + eol;
  // unit output dir
  if UnitOutputDir <> '' then
    c := c + ' -FU' + UnitOutputDir + eol;
  // make option - compiler flags
  for i := 0 to MakeOptions.Count-1 do
    if MakeOptionsGrid[b, i] then
      c := c + ' ' + MakeOptions[i];
  // target output file
  if TargetFile <> '' then
    c := c + ' -o' + TargetFile;
  // unit to start compilation
  c := c + ' ' + MainUnit;

  Result := c;
end;

procedure TProject.ClearAndInitMakeOptions(const ASize: integer);
begin
  FMakeOptions.Clear;
  SetLength(FMakeOptionsGrid, 0, 0);    // free items
  SetLength(FMakeOptionsGrid, 6, ASize);    // 6 columns by X rows
end;

procedure TProject.ClearAndInitUnitDirsGrid(const ASize: integer);
begin
  FUnitDirs.Clear;
  SetLength(FUnitDirsGrid, 0, 0); // free items
  SetLength(FUnitDirsGrid, 10, ASize);   // 10 columns by X rows
end;

procedure TProject.ClearAndInitMacrosGrid(const ASize: integer);
begin
  FMacroNames.Clear;
end;


initialization
  uProject := nil;

finalization
  FreeProject;

end.