codetools: started simple setup for laz packages

git-svn-id: trunk@37992 -

components/codetools/ctloadlaz.pas

@@ -30,110 +30,210 @@ unit ctloadlaz;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils, FileProcs, Laz2_XMLCfg;
 
 type
+  TCTLParseString = record
+    UnparsedValue: string;
+    ParsedValue: string;
+    ParseStamp: int64;
+    Parsing: boolean;
+  end;
+
+  TCTLModuleValue = (
+    clmBaseDir,
+    clmFilename,
+    clmIncPath,
+    clmUnitPath,
+    clmSrcPath,
+    clmOutputDir
+    );
 
   { TCTLazarusModule }
 
   TCTLazarusModule = class
   private
-    FBaseDir: string;
     FFilename: string;
     FFiles: TStrings;
-    FIncludePath: string;
     FName: string;
-    FOutputDir: string;
+    function GetBaseDir: string;
-    FUnitPath: string;
+    function GetIncludePath: string;
-    procedure SetBaseDir(AValue: string);
+    function GetOutputDir: string;
-    procedure SetFilename(AValue: string);
+    function GetSrcPath: string;
-    procedure SetFiles(AValue: TStrings);
+    function GetUnitPath: string;
-    procedure SetIncludePath(AValue: string);
+  protected
-    procedure SetName(AValue: string);
+    FParseValues: array[TCTLModuleValue] of TCTLParseString;
-    procedure SetOutputDir(AValue: string);
+    procedure SetUnparsedValue(Prop: TCTLModuleValue; NewValue: string);
-    procedure SetUnitPath(AValue: string);
+    procedure SetBaseDir(AValue: string); virtual;
+    procedure SetFilename(AValue: string); virtual;
+    procedure SetFiles(AValue: TStrings); virtual;
+    procedure SetIncludePath(AValue: string); virtual;
+    procedure SetName(AValue: string); virtual;
+    procedure SetOutputDir(AValue: string); virtual;
+    procedure SetSrcPath(AValue: string); virtual;
+    procedure SetUnitPath(AValue: string); virtual;
   public
     constructor Create;
     destructor Destroy; override;
-    procedure Clear;
+    procedure Clear; virtual;
+    procedure LoadFromFile(aFilename: string); virtual;
+    procedure LoadFromConfig(Cfg: TXMLConfig); virtual;
     property Filename: string read FFilename write SetFilename;
     property Name: string read FName write SetName;
-    property BaseDir: string read FBaseDir write SetBaseDir;
+    property BaseDir: string read GetBaseDir write SetBaseDir;
-    property UnitPath: string read FUnitPath write SetUnitPath;
+    property UnitPath: string read GetUnitPath write SetUnitPath;
-    property IncludePath: string read FIncludePath write SetIncludePath;
+    property IncludePath: string read GetIncludePath write SetIncludePath;
-    property OutputDir: string read FOutputDir write SetOutputDir;
+    property SrcPath: string read GetSrcPath write SetSrcPath;
+    property OutputDir: string read GetOutputDir write SetOutputDir;
     property Files: TStrings read FFiles write SetFiles;
   end;
 
   TCTLazarusPackage = class(TCTLazarusModule)
-
+  public
   end;
 
   TCTLazarusProject = class(TCTLazarusModule)
-
+  public
   end;
 
   { TCTLazarusManager }
 
   TCTLazarusManager = class
   private
+    FActiveProject: TCTLazarusProject;
     FPrimaryConfigPath: string;
+    procedure SetActiveProject(AValue: TCTLazarusProject);
     procedure SetPrimaryConfigPath(AValue: string);
   public
     constructor Create;
     destructor Destroy; override;
     procedure ParseParams;
     property PrimaryConfigPath: string read FPrimaryConfigPath write SetPrimaryConfigPath;
-    property ActiveModule: TCTLazarusModule;
+    property ActiveProject: TCTLazarusProject read FActiveProject write SetActiveProject;
+    procedure OpenProject(var aProject: TCTLazarusProject; aFilename: string);
   end;
 
 var
-  LazarusOptions: TCTLazarusManager = nil;
+  CTLazarusBoss: TCTLazarusManager = nil;
+  CTLazParseStamp: int64 = CTInvalidChangeStamp64;
+
+procedure CreateCTLazarusBoss;
+procedure IncreaseCTLazParseStamp;
 
 implementation
 
+procedure CreateCTLazarusBoss;
+begin
+  CTLazarusBoss:=TCTLazarusManager.Create;
+end;
+
+procedure IncreaseCTLazParseStamp;
+begin
+  CTIncreaseChangeStamp64(CTLazParseStamp);
+end;
+
 { TCTLazarusModule }
 
-procedure TCTLazarusModule.SetBaseDir(AValue: string);
+function TCTLazarusModule.GetBaseDir: string;
 begin
-  if FBaseDir=AValue then Exit;
+  Result:=FParseValues[clmBaseDir].UnparsedValue;
-  FBaseDir:=AValue;
+end;
+
+function TCTLazarusModule.GetIncludePath: string;
+begin
+  Result:=FParseValues[clmIncPath].UnparsedValue;
+end;
+
+function TCTLazarusModule.GetOutputDir: string;
+begin
+  Result:=FParseValues[clmOutputDir].UnparsedValue;
+end;
+
+function TCTLazarusModule.GetSrcPath: string;
+begin
+  Result:=FParseValues[clmSrcPath].UnparsedValue;
+end;
+
+function TCTLazarusModule.GetUnitPath: string;
+begin
+  Result:=FParseValues[clmUnitPath].UnparsedValue;
+end;
+
+procedure TCTLazarusModule.SetUnparsedValue(Prop: TCTLModuleValue;
+  NewValue: string);
+begin
+  if FParseValues[Prop].UnparsedValue=NewValue then exit;
+  if FParseValues[Prop].Parsing then
+    raise Exception.Create('TCTLazarusModule.SetParsedValue can not set while parsing');
+  FParseValues[Prop].UnparsedValue:=NewValue;
+  FParseValues[Prop].ParseStamp:=CTLazParseStamp;
+  IncreaseCTLazParseStamp;
+end;
+
+procedure TCTLazarusModule.SetBaseDir(AValue: string);
+var
+  NewValue: String;
+begin
+  NewValue:=TrimFilename(AValue);
+  if BaseDir=NewValue then Exit;
+  SetUnparsedValue(clmBaseDir,NewValue);
 end;
 
 procedure TCTLazarusModule.SetFilename(AValue: string);
 begin
   if FFilename=AValue then Exit;
   FFilename:=AValue;
+  BaseDir:=ExtractFilePath(FFilename);
+  IncreaseCTLazParseStamp;
 end;
 
 procedure TCTLazarusModule.SetFiles(AValue: TStrings);
 begin
-  if FFiles=AValue then Exit;
+  if FFiles.Equals(AValue) then Exit;
-  FFiles:=AValue;
+  FFiles.Assign(AValue);
 end;
 
 procedure TCTLazarusModule.SetIncludePath(AValue: string);
+var
+  NewValue: String;
 begin
-  if FIncludePath=AValue then Exit;
+  NewValue:=Trim(AValue);
-  FIncludePath:=AValue;
+  if IncludePath=NewValue then Exit;
+  SetUnparsedValue(clmIncPath,NewValue);
 end;
 
 procedure TCTLazarusModule.SetName(AValue: string);
 begin
   if FName=AValue then Exit;
   FName:=AValue;
+  IncreaseCTLazParseStamp;
 end;
 
 procedure TCTLazarusModule.SetOutputDir(AValue: string);
+var
+  NewValue: String;
 begin
-  if FOutputDir=AValue then Exit;
+  NewValue:=TrimFilename(AValue);
-  FOutputDir:=AValue;
+  if OutputDir=NewValue then Exit;
+  SetUnparsedValue(clmOutputDir,NewValue);
+end;
+
+procedure TCTLazarusModule.SetSrcPath(AValue: string);
+var
+  NewValue: String;
+begin
+  NewValue:=Trim(AValue);
+  if SrcPath=NewValue then Exit;
+  SetUnparsedValue(clmSrcPath,NewValue);
 end;
 
 procedure TCTLazarusModule.SetUnitPath(AValue: string);
+var
+  NewValue: String;
 begin
-  if FUnitPath=AValue then Exit;
+  NewValue:=Trim(AValue);
-  FUnitPath:=AValue;
+  if UnitPath=NewValue then Exit;
+  SetUnparsedValue(clmUnitPath,NewValue);
 end;
 
 constructor TCTLazarusModule.Create;
@@ -149,6 +249,29 @@ begin
 end;
 
 procedure TCTLazarusModule.Clear;
+begin
+  FFiles.Clear;
+  UnitPath:='';
+  IncludePath:='';
+  SrcPath:='';
+  OutputDir:='';
+end;
+
+procedure TCTLazarusModule.LoadFromFile(aFilename: string);
+var
+  Cfg: TXMLConfig;
+begin
+  Clear;
+  Filename:=TrimAndExpandFilename(aFilename);
+  Cfg:=TXMLConfig.Create(Filename);
+  try
+    LoadFromConfig(Cfg);
+  finally
+    Cfg.Free;
+  end;
+end;
+
+procedure TCTLazarusModule.LoadFromConfig(Cfg: TXMLConfig);
 begin
 
 end;
@@ -161,6 +284,12 @@ begin
   FPrimaryConfigPath:=AValue;
 end;
 
+procedure TCTLazarusManager.SetActiveProject(AValue: TCTLazarusProject);
+begin
+  if FActiveProject=AValue then Exit;
+  FActiveProject:=AValue;
+end;
+
 constructor TCTLazarusManager.Create;
 begin
 
@@ -193,9 +322,18 @@ begin
   end;
 end;
 
+procedure TCTLazarusManager.OpenProject(var aProject: TCTLazarusProject;
+  aFilename: string);
+begin
+  aFilename:=TrimAndExpandFilename(aFilename);
+  if aProject=nil then
+    aProject:=TCTLazarusProject.Create;
+  aProject.LoadFromFile(aFilename);
+end;
+
 initialization
-  LazarusOptions:=TCTLazarusManager.Create;
+  CTLazarusBoss:=TCTLazarusManager.Create;
 finalization;
-  FreeAndNil(LazarusOptions);
+  FreeAndNil(CTLazarusBoss);
 end.