diff --git a/.gitattributes b/.gitattributes index 0866ed8189..7eccb8212c 100644 --- a/.gitattributes +++ b/.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 diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 3fb606e5ab..f598fab2dc 100644 --- a/components/codetools/codetoolmanager.pas +++ b/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; diff --git a/components/codetools/codetoolsconfig.pas b/components/codetools/codetoolsconfig.pas new file mode 100644 index 0000000000..e44798a732 --- /dev/null +++ b/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 . 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. + diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 930d0ff342..531afc0419 100644 --- a/components/codetools/definetemplates.pas +++ b/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 - CmdLine:=CmdLine+PPCOptions+' '; + if CompilerOptions<>'' then + 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; - if PPCOptions<>'' then - CmdLine:=CmdLine+' '+PPCOptions; + CmdLine:=CompilerPath; + if CompilerOptions<>'' then + 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; - if PPCOptions<>'' then - CmdLine:=CmdLine+' '+PPCOptions; + CmdLine:=CompilerPath; + if CompilerOptions<>'' then + CmdLine:=CmdLine+' '+CompilerOptions; CmdLine:=CmdLine+' -iTP'; TheProcess.CommandLine := CmdLine; TheProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];