added codetools config

git-svn-id: trunk@8614 -

.gitattributes

@@ -51,6 +51,7 @@ components/codetools/codetemplatestool.pas svneol=native#text/pascal
 components/codetools/codetoolmanager.pas svneol=native#text/pascal
 components/codetools/codetoolmemmanager.pas svneol=native#text/pascal
 components/codetools/codetools.inc svneol=native#text/pascal
+components/codetools/codetoolsconfig.pas svneol=native#text/plain
 components/codetools/codetoolsstrconsts.pas svneol=native#text/pascal
 components/codetools/codetoolsstructs.pas svneol=native#text/pascal
 components/codetools/codetree.pas svneol=native#text/pascal

components/codetools/codetoolmanager.pas

@@ -43,7 +43,7 @@ uses
   Classes, SysUtils, FileProcs, BasicCodeTools, CodeToolsStrConsts,
   EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
   ExprEval, LinkScanner, KeywordFuncLists, TypInfo,
-  AVL_Tree, LFMTrees, PascalParserTool,
+  AVL_Tree, LFMTrees, PascalParserTool, CodeToolsConfig,
   CustomCodeTool, FindDeclarationTool, IdentCompletionTool, StdCodeTools,
   ResourceCodeTool, CodeToolsStructs, CodeTemplatesTool, ExtractProcTool;
 
@@ -142,10 +142,12 @@ type
     IdentifierList: TIdentifierList;
     IdentifierHistory: TIdentifierHistoryList;
     Positions: TCodeXYPositions;
-    
+
     constructor Create;
     destructor Destroy; override;
-
+    
+    procedure Init(Config: TCodeToolsOptions);
+    
     procedure ActivateWriteLock;
     procedure DeactivateWriteLock;
 
@@ -659,6 +661,50 @@ begin
   {$ENDIF}
 end;
 
+procedure TCodeToolManager.Init(Config: TCodeToolsOptions);
+var
+  FPCUnitPath, TargetOS, TargetProcessor: string;
+  UnitLinkList: String;
+begin
+  // set global values
+  with GlobalValues do begin
+    Variables[ExternalMacroStart+'LazarusSrcDir']:=Config.LazarusSrcDir;
+    Variables[ExternalMacroStart+'FPCSrcDir']:=Config.FPCSrcDir;
+    Variables[ExternalMacroStart+'LCLWidgetType']:=Config.LCLWidgetType;
+    Variables[ExternalMacroStart+'ProjectDir']:=Config.ProjectDir;
+  end;
+
+  // build DefinePool
+  with DefinePool do begin
+    FPCUnitPath:=Config.FPCUnitPath;
+    TargetOS:=Config.FPCUnitPath;
+    TargetProcessor:=Config.TargetProcessor;
+    Add(CreateFPCTemplate(Config.FPCPath, Config.FPCOptions,
+                          Config.TestPascalFile,
+                          FPCUnitPath, TargetOS, TargetProcessor,
+                          nil));
+    Config.FPCUnitPath:=FPCUnitPath;
+    Config.TargetOS:=FPCUnitPath;
+    Config.TargetProcessor:=TargetProcessor;
+    UnitLinkList:=Config.UnitLinkList;
+    Add(CreateFPCSrcTemplate(Config.FPCSrcDir,Config.FPCUnitPath,Config.PPUExt,
+                          Config.TargetOS, Config.TargetProcessor,
+                          Config.UnitLinkListValid,UnitLinkList,
+                          nil));
+    Config.UnitLinkListValid:=true;
+    Config.UnitLinkList:=UnitLinkList;
+    Add(CreateLazarusSrcTemplate('$(#LazarusSrcDir)','$(#LCLWidgetType)',
+                                 Config.LazarusSrcOptions,nil));
+  end;
+
+  // build define tree
+  DefineTree.Add(DefinePool[0].CreateCopy(false,true,true));
+  DefineTree.Add(DefinePool[1].CreateCopy(false,true,true));
+  DefineTree.Add(DefinePool[2].CreateCopy(false,true,true));
+  DefineTree.Add(DefinePool.CreateLCLProjectTemplate(
+                 '$(#LazarusSrcDir)','$(#LCLWidgetType)','$(#ProjectDir)',nil));
+end;
+
 procedure TCodeToolManager.BeginUpdate;
 begin
   SourceChangeCache.BeginUpdate;

components/codetools/codetoolsconfig.pas

@@ -0,0 +1,287 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    This unit helps to setup and configure the codetools.
+}
+unit CodeToolsConfig;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Laz_XMLCfg, FileProcs, DefineTemplates;
+  
+type
+
+  { TCodeToolsOptions }
+
+  TCodeToolsOptions = class
+  private
+    FDefaultTargetOS: string;
+    FDefaultTargetProcessor: string;
+    FFPCOptions: string;
+    FFPCPath: string;
+    FFPCSrcDir: string;
+    FFPCUnitPath: string;
+    FLazarusSrcDir: string;
+    FLazarusSrcOptions: string;
+    FLCLWidgetType: string;
+    FModified: boolean;
+    FPPUExt: string;
+    FProjectDir: string;
+    FTargetOS: string;
+    FTargetProcessor: string;
+    FTestPascalFile: string;
+    FUnitLinkList: string;
+    FUnitLinkListValid: boolean;
+    procedure SetFPCOptions(const AValue: string);
+    procedure SetFPCPath(const AValue: string);
+    procedure SetFPCSrcDir(const AValue: string);
+    procedure SetFPCUnitPath(const AValue: string);
+    procedure SetLazarusSrcDir(const AValue: string);
+    procedure SetLCLWidgetType(const AValue: string);
+    procedure SetLazarusSrcOptions(const AValue: string);
+    procedure SetModified(const AValue: boolean);
+    procedure SetPPUExt(const AValue: string);
+    procedure SetProjectDir(const AValue: string);
+    procedure SetTargetOS(const AValue: string);
+    procedure SetTargetProcessor(const AValue: string);
+    procedure SetTestPascalFile(const AValue: string);
+    procedure SetUnitLinkList(const AValue: string);
+    procedure SetUnitLinkListValid(const AValue: boolean);
+  public
+    constructor Create;
+    
+    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
+    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
+    procedure SaveToFile(const Filename: string);
+    procedure LoadFromFile(const Filename: string);
+
+    property Modified: boolean read FModified write SetModified;
+
+    // FPC
+    property FPCSrcDir: string read FFPCSrcDir write SetFPCSrcDir; // e.g. /usr/shar/fpcsrc
+    property FPCPath: string read FFPCPath write SetFPCPath; // e.g. /usr/bin/ppc386
+    property FPCOptions: string read FFPCOptions write SetFPCOptions;
+    property TargetOS: string read FTargetOS write SetTargetOS;
+    property TargetProcessor: string read FTargetProcessor write SetTargetProcessor;
+    property DefaultTargetOS: string read FDefaultTargetOS;
+    property DefaultTargetProcessor: string read FDefaultTargetProcessor;
+    property TestPascalFile: string read FTestPascalFile write SetTestPascalFile; // points to an empty unit
+    property FPCUnitPath: string read FFPCUnitPath write SetFPCUnitPath;
+    property PPUExt: string read FPPUExt write SetPPUExt;
+    property UnitLinkListValid: boolean read FUnitLinkListValid write SetUnitLinkListValid;
+    property UnitLinkList: string read FUnitLinkList write SetUnitLinkList;
+
+    // Project
+    property ProjectDir: string read FProjectDir write SetProjectDir;
+    
+    // Lazarus
+    property LazarusSrcDir: string read FLazarusSrcDir write SetLazarusSrcDir;
+    property LCLWidgetType: string read FLCLWidgetType write SetLCLWidgetType;
+    property LazarusSrcOptions: string read FLazarusSrcOptions write SetLazarusSrcOptions;
+  end;
+
+implementation
+
+{ TCodeToolsOptions }
+
+procedure TCodeToolsOptions.SetFPCOptions(const AValue: string);
+begin
+  if FFPCOptions=AValue then exit;
+  FFPCOptions:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetFPCPath(const AValue: string);
+begin
+  if FFPCPath=AValue then exit;
+  FFPCPath:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetFPCSrcDir(const AValue: string);
+begin
+  if FFPCSrcDir=AValue then exit;
+  FFPCSrcDir:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetFPCUnitPath(const AValue: string);
+begin
+  if FFPCUnitPath=AValue then exit;
+  FFPCUnitPath:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetLazarusSrcDir(const AValue: string);
+begin
+  if FLazarusSrcDir=AValue then exit;
+  FLazarusSrcDir:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetLCLWidgetType(const AValue: string);
+begin
+  if FLCLWidgetType=AValue then exit;
+  FLCLWidgetType:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetLazarusSrcOptions(const AValue: string);
+begin
+  if FLazarusSrcOptions=AValue then exit;
+  FLazarusSrcOptions:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetModified(const AValue: boolean);
+begin
+  if FModified=AValue then exit;
+  FModified:=AValue;
+end;
+
+procedure TCodeToolsOptions.SetPPUExt(const AValue: string);
+begin
+  if FPPUExt=AValue then exit;
+  FPPUExt:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetProjectDir(const AValue: string);
+begin
+  if FProjectDir=AValue then exit;
+  FProjectDir:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetTargetOS(const AValue: string);
+begin
+  if FTargetOS=AValue then exit;
+  FTargetOS:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetTargetProcessor(const AValue: string);
+begin
+  if FTargetProcessor=AValue then exit;
+  FTargetProcessor:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetTestPascalFile(const AValue: string);
+begin
+  if FTestPascalFile=AValue then exit;
+  FTestPascalFile:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetUnitLinkList(const AValue: string);
+begin
+  if FUnitLinkList=AValue then exit;
+  FUnitLinkList:=AValue;
+  Modified:=true;
+end;
+
+procedure TCodeToolsOptions.SetUnitLinkListValid(const AValue: boolean);
+begin
+  if FUnitLinkListValid=AValue then exit;
+  FUnitLinkListValid:=AValue;
+  Modified:=true;
+end;
+
+constructor TCodeToolsOptions.Create;
+begin
+  FPPUExt:='.ppu';
+  FLCLWidgetType:='gtk';
+end;
+
+procedure TCodeToolsOptions.SaveToXMLConfig(XMLConfig: TXMLConfig;
+  const Path: string);
+begin
+  XMLConfig.SetDeleteValue(Path+'FPC/Options/Value',FPCOptions,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/CompilerPath/Value',FPCPath,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/SrcDir/Value',FPCSrcDir,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/UnitPath/Value',FPCUnitPath,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/TargetOS/Value',TargetOS,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/TargetProcessor/Value',TargetProcessor,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/PPUExt/Value',PPUExt,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/TestPascalFile/Value',TestPascalFile,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/UnitLinkList/Value',UnitLinkList,'');
+  XMLConfig.SetDeleteValue(Path+'FPC/UnitLinkList/Valid',UnitLinkListValid,false);
+  XMLConfig.SetDeleteValue(Path+'Lazarus/SrcDir/Value',LazarusSrcDir,'');
+  XMLConfig.SetDeleteValue(Path+'Lazarus/SrcDirOptions/Value',LazarusSrcOptions,'');
+  XMLConfig.SetDeleteValue(Path+'Lazarus/LCLWidgetType/Value',LCLWidgetType,'');
+  XMLConfig.SetDeleteValue(Path+'Project/Dir/Value',ProjectDir,'');
+  Modified:=false;
+end;
+
+procedure TCodeToolsOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
+  const Path: string);
+begin
+  FPCOptions:=XMLConfig.GetValue(Path+'FPC/Options/Value','');
+  FPCPath:=XMLConfig.GetValue(Path+'FPC/CompilerPath/Value','');
+  FPCSrcDir:=XMLConfig.GetValue(Path+'FPC/SrcDir/Value','');
+  FPCUnitPath:=XMLConfig.GetValue(Path+'FPC/UnitPath/Value','');
+  TargetOS:=XMLConfig.GetValue(Path+'FPC/TargetOS/Value','');
+  TargetProcessor:=XMLConfig.GetValue(Path+'FPC/TargetProcessor/Value','');
+  PPUExt:=XMLConfig.GetValue(Path+'FPC/PPUExt/Value','');
+  TestPascalFile:=XMLConfig.GetValue(Path+'FPC/TestPascalFile/Value','');
+  UnitLinkList:=XMLConfig.GetValue(Path+'FPC/UnitLinkList/Value','');
+  UnitLinkListValid:=XMLConfig.GetValue(Path+'FPC/UnitLinkList/Valid',false);
+  LazarusSrcDir:=XMLConfig.GetValue(Path+'Lazarus/SrcDir/Value','');
+  LazarusSrcOptions:=XMLConfig.GetValue(Path+'Lazarus/SrcDirOptions/Value','');
+  LCLWidgetType:=XMLConfig.GetValue(Path+'Lazarus/LCLWidgetType/Value','');
+  ProjectDir:=XMLConfig.GetValue(Path+'Project/Dir/Value','');
+  Modified:=false;
+end;
+
+procedure TCodeToolsOptions.SaveToFile(const Filename: string);
+var
+  XMLConfig: TXMLConfig;
+begin
+  XMLConfig:=TXMLConfig.CreateClean(Filename);
+  try
+    SaveToXMLConfig(XMLConfig,'CodeToolsOptions/');
+    XMLConfig.Flush;
+  finally
+    XMLConfig.Free;
+  end;
+end;
+
+procedure TCodeToolsOptions.LoadFromFile(const Filename: string);
+var
+  XMLConfig: TXMLConfig;
+begin
+  XMLConfig:=TXMLConfig.Create(Filename);
+  try
+    LoadFromXMLConfig(XMLConfig,'CodeToolsOptions/');
+    XMLConfig.Flush;
+  finally
+    XMLConfig.Free;
+  end;
+end;
+
+end.
+

components/codetools/definetemplates.pas

@@ -41,7 +41,7 @@
     some default templates for Lazarus and FPC sources.
     
   ToDo:
-    Error handling for DefinePool
+    Better Error handling of DefinePool
 }
 unit DefineTemplates;
 
@@ -403,7 +403,7 @@ type
     property EnglishErrorMsgFilename: string
         read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename;
     // FPC templates
-    function CreateFPCTemplate(const PPC386Path, PPCOptions,
+    function CreateFPCTemplate(const CompilerPath, CompilerOptions,
                                TestPascalFile: string;
                                var UnitSearchPath, TargetOS,
                                TargetProcessor: string;
@@ -2658,7 +2658,7 @@ begin
 end;
 
 function TDefinePool.CreateFPCTemplate(
-  const PPC386Path, PPCOptions, TestPascalFile: string;
+  const CompilerPath, CompilerOptions, TestPascalFile: string;
   var UnitSearchPath, TargetOS, TargetProcessor: string;
   Owner: TObject): TDefineTemplate;
 // create symbol definitions for the freepascal compiler
@@ -2766,23 +2766,23 @@ var CmdLine: string;
   SrcOS: string;
   SrcOS2: String;
 begin
-  //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',PPC386Path,'" PPCOptions="',PPCOptions,'"');
+  //DebugLn('TDefinePool.CreateFPCTemplate PPC386Path="',CompilerPath,'" PPCOptions="',CompilerOptions,'"');
   Result:=nil;
   UnitSearchPath:='';
   TargetOS:='';
   SrcOS:='';
   TargetProcessor:='';
-  if (PPC386Path='') or (not FileIsExecutable(PPC386Path)) then exit;
+  if (CompilerPath='') or (not FileIsExecutable(CompilerPath)) then exit;
   LastDefTempl:=nil;
   // find all initial compiler macros and all unit paths
   // -> ask compiler with the -vm -vt switch
   SetLength(Buf,1024);
   try
-    CmdLine:=PPC386Path+' -va ';
+    CmdLine:=CompilerPath+' -va ';
     if FileExistsCached(EnglishErrorMsgFilename) then
       CmdLine:=CmdLine+'-Fr'+EnglishErrorMsgFilename+' ';
-    if PPCOptions<>'' then
+    if CompilerOptions<>'' then
-      CmdLine:=CmdLine+PPCOptions+' ';
+      CmdLine:=CmdLine+CompilerOptions+' ';
     CmdLine:=CmdLine+TestPascalFile;
     //DebugLn('TDefinePool.CreateFPCTemplate CmdLine="',CmdLine,'"');
     ShortTestFile:=ExtractFileName(TestPascalFile);
@@ -2823,9 +2823,9 @@ begin
     //DebugLn('TDefinePool.CreateFPCTemplate First done');
 
     // ask for target operating system -> ask compiler with switch -iTO
-    CmdLine:=PPC386Path;
+    CmdLine:=CompilerPath;
-    if PPCOptions<>'' then
+    if CompilerOptions<>'' then
-      CmdLine:=CmdLine+' '+PPCOptions;
+      CmdLine:=CmdLine+' '+CompilerOptions;
     CmdLine:=CmdLine+' -iTO';
 
     TheProcess := TProcess.Create(nil);
@@ -2873,9 +2873,9 @@ begin
     
     // ask for target processor -> ask compiler with switch -iTP
     TheProcess := TProcess.Create(nil);
-    CmdLine:=PPC386Path;
+    CmdLine:=CompilerPath;
-    if PPCOptions<>'' then
+    if CompilerOptions<>'' then
-      CmdLine:=CmdLine+' '+PPCOptions;
+      CmdLine:=CmdLine+' '+CompilerOptions;
     CmdLine:=CmdLine+' -iTP';
     TheProcess.CommandLine := CmdLine;
     TheProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];