mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-04 05:03:57 +02:00
added codetools config
git-svn-id: trunk@8614 -
This commit is contained in:
mattias
parent
40c0cd86f7
commit
60b17ba91f
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
287
components/codetools/codetoolsconfig.pas
Normal file
287
components/codetools/codetoolsconfig.pas
Normal file
@ -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.
|
||||
|
||||
@ -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];
|
||||
|
||||
Loading…
Reference in New Issue
Block a user