mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 12:16:18 +02:00
* Improve Delphi Compiler tool, so it provides some macros and handles windows/unix paths when running with wine
This commit is contained in:
Michaël Van Canneyt
parent
87bf39682e
commit
600d7f8666
131
components/compilers/delphi/delphioptions.pas
Normal file
131
components/compilers/delphi/delphioptions.pas
Normal file
@ -0,0 +1,131 @@
|
||||
unit delphioptions;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazConfigStorage;
|
||||
|
||||
Const
|
||||
DefaultCompilerFileName = 'dcc32.exe';
|
||||
DefaultGenConfig = True;
|
||||
DefaultConfigExtension = '.conf';
|
||||
DefaultConvertPathsToUnix = {$IFDEF UNIX}True{$ELSE}False{$ENDIF};
|
||||
DefaultAdditionalOptions = '';
|
||||
|
||||
Type
|
||||
|
||||
{ TDelphiToolOptions }
|
||||
|
||||
TDelphiToolOptions = Class(TPersistent)
|
||||
Private
|
||||
FAdditionalOptions: String;
|
||||
FCompilerFileName: String;
|
||||
FConfigFileExtension: String;
|
||||
FConvertPathsToUnix: Boolean;
|
||||
FGenerateConfigFile: Boolean;
|
||||
class var _Instance : TDelphiToolOptions;
|
||||
Protected
|
||||
procedure LoadFromConfig(Cfg: TConfigStorage); virtual;
|
||||
procedure SaveToConfig(Cfg: TConfigStorage); virtual;
|
||||
Public
|
||||
Constructor Create; virtual;
|
||||
class constructor init;
|
||||
class destructor Done;
|
||||
procedure Load;
|
||||
procedure Save;
|
||||
procedure Reset;
|
||||
class property Instance : TDelphiToolOptions Read _Instance;
|
||||
Property CompilerFileName : String Read FCompilerFileName Write FCompilerFileName;
|
||||
Property GenerateConfigFile : Boolean Read FGenerateConfigFile Write FGenerateConfigFile;
|
||||
Property ConfigFileExtension : String Read FConfigFileExtension Write FConfigFileExtension;
|
||||
Property ConvertPathsToUnix : Boolean Read FConvertPathsToUnix Write FConvertPathsToUnix;
|
||||
Property AdditionalOptions : String Read FAdditionalOptions Write FAdditionalOptions;
|
||||
end;
|
||||
|
||||
Function DelphiToolOptions : TDelphiToolOptions;
|
||||
|
||||
implementation
|
||||
|
||||
uses BaseIDEIntf, strdelphitool;
|
||||
|
||||
function DelphiToolOptions: TDelphiToolOptions;
|
||||
begin
|
||||
Result:=TDelphiToolOptions.Instance;
|
||||
end;
|
||||
|
||||
{ TDelphiToolOptions }
|
||||
|
||||
procedure TDelphiToolOptions.LoadFromConfig(Cfg: TConfigStorage);
|
||||
begin
|
||||
CompilerFilename:=Cfg.GetValue(KeyCompiler, CompilerFilename);
|
||||
GenerateConfigFile:=Cfg.GetValue(KeyGenConfigFile, GenerateConfigFile);
|
||||
ConfigFileExtension:=Cfg.GetValue(KeyConfigFileExt, ConfigFileExtension);
|
||||
ConvertPathsToUnix:=Cfg.GetValue(KeyConvertPaths, ConvertPathsToUnix);
|
||||
AdditionalOptions:=Cfg.GetValue(KeyConvertPaths, AdditionalOptions);
|
||||
end;
|
||||
|
||||
procedure TDelphiToolOptions.SaveToConfig(Cfg: TConfigStorage);
|
||||
begin
|
||||
Cfg.SetDeleteValue(KeyCompiler, CompilerFilename, DefaultCompilerFileName);
|
||||
Cfg.SetDeleteValue(KeyGenConfigFile, GenerateConfigFile, DefaultGenConfig);
|
||||
Cfg.SetDeleteValue(KeyConfigFileExt, ConfigFileExtension, DefaultConfigExtension);
|
||||
Cfg.SetDeleteValue(KeyConvertPaths, ConvertPathsToUnix, DefaultConvertPathsToUnix);
|
||||
Cfg.SetDeleteValue(KeyConvertPaths, AdditionalOptions, DefaultAdditionalOptions);
|
||||
end;
|
||||
|
||||
constructor TDelphiToolOptions.Create;
|
||||
begin
|
||||
Reset;
|
||||
end;
|
||||
|
||||
class constructor TDelphiToolOptions.init;
|
||||
begin
|
||||
_Instance:=TDelphiToolOptions.Create;
|
||||
end;
|
||||
|
||||
class destructor TDelphiToolOptions.Done;
|
||||
begin
|
||||
FreeAndNil(_Instance)
|
||||
end;
|
||||
|
||||
procedure TDelphiToolOptions.Load;
|
||||
|
||||
var
|
||||
Cfg: TConfigStorage;
|
||||
|
||||
begin
|
||||
Cfg:=GetIDEConfigStorage(DelphiToolsOptionsFile,true);
|
||||
try
|
||||
LoadFromConfig(Cfg);
|
||||
finally
|
||||
Cfg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDelphiToolOptions.Save;
|
||||
|
||||
var
|
||||
Cfg: TConfigStorage;
|
||||
|
||||
begin
|
||||
Cfg:=GetIDEConfigStorage(DelphiToolsOptionsFile,false);
|
||||
try
|
||||
SaveToConfig(Cfg);
|
||||
finally
|
||||
Cfg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDelphiToolOptions.Reset;
|
||||
begin
|
||||
CompilerFileName:=DefaultCompilerFileName;
|
||||
GenerateConfigFile:=DefaultGenConfig;
|
||||
ConfigFileExtension:=DefaultConfigExtension;
|
||||
ConvertPathsToUnix:=DefaultConvertPathsToUnix;
|
||||
AdditionalOptions:=DefaultAdditionalOptions;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
544
components/compilers/delphi/delphitool.pas
Normal file
544
components/compilers/delphi/delphitool.pas
Normal file
@ -0,0 +1,544 @@
|
||||
unit delphitool;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, System.UITypes, dialogs, CompOptsIntf, IDEExternToolIntf, MacroDefIntf, MacroIntf, RegExpr, strdelphitool;
|
||||
|
||||
|
||||
Const
|
||||
SubToolDelphiPriority = SubToolFPCPriority-10;
|
||||
|
||||
type
|
||||
|
||||
{ TWinePathConverter }
|
||||
|
||||
TWinePathConverter = Class
|
||||
Private
|
||||
FMap : TStrings;
|
||||
Protected
|
||||
Procedure FillMap; virtual;
|
||||
Public
|
||||
Constructor Create;
|
||||
Destructor Destroy; override;
|
||||
Function UnixToWindows(Const aFileName : String) : String; virtual;
|
||||
function WindowsToUnix(Const aFileName : String) : String; virtual;
|
||||
end;
|
||||
|
||||
{ TDelphiCompilerParser }
|
||||
|
||||
TDelphiCompilerParser = class(TExtToolParser)
|
||||
private
|
||||
protected
|
||||
FRegExprFilenameLineIDMsg: TRegExpr;
|
||||
FRegExprFilenameLineUrgencyIDMsg: TRegExpr;
|
||||
FConverter : TWinePathConverter;
|
||||
Function CreateConverter : TWinePathConverter;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ReadLine(Line: string; OutputIndex: integer; IsStdErr: boolean;
|
||||
var Handled: boolean); override; // (worker thread)
|
||||
class function DefaultSubTool: string; override;
|
||||
class function GetParserName: string; override;
|
||||
class function GetLocalizedParserName: string; override;
|
||||
class function Priority: integer; override;
|
||||
end;
|
||||
TDelphiCompilerParserClass = class of TDelphiCompilerParser;
|
||||
|
||||
{ TDelphiTool }
|
||||
TDelphiMacro = (dmCompiler,dmConfigFileName,dmAdditionalArgs,dmCompileCommand);
|
||||
TDelphiTool = class
|
||||
private
|
||||
class var _instance: TDelphiTool;
|
||||
Private
|
||||
FMacros : Array[TDelphiMacro] of TTransferMacro;
|
||||
Protected
|
||||
function GetCompileCommand(const s: string; const Data: PtrInt; var Abort: boolean): string; virtual;
|
||||
function GetCompilerArgs(const s: string; const Data: PtrInt; var Abort: boolean): string; virtual;
|
||||
function GetCompilerPath(const s: string; const Data: PtrInt; var Abort: boolean): string; virtual;
|
||||
function GetConfigPath(const s: string; const Data: PtrInt; var Abort: boolean): string; virtual;
|
||||
function OnProjectBuilding(Sender: TObject): TModalResult; virtual;
|
||||
function FPCToDelphiOpts(Opts: TLazCompilerOptions; aDelphiOpts: TStrings): Integer; virtual;
|
||||
function GenerateConfigFilename(const aFilename: String): Boolean; virtual;
|
||||
Public
|
||||
Destructor Destroy; override;
|
||||
Class Constructor Init;
|
||||
Class Destructor Done;
|
||||
Procedure Hook; virtual;
|
||||
Procedure UnHook; virtual;
|
||||
Function GetParsedCompilerFilename : String;
|
||||
Function GetCurrentConfigFileName(PrependAt: Boolean = true) : String;
|
||||
Function GetCompilerArguments: string;
|
||||
Function GetCompileCommand: string;
|
||||
Class Property Instance: TDelphiTool read _Instance;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX} baseunix, {$ENDIF}
|
||||
LazIDEIntf, LazLoggerBase, LazUtilities, delphioptions, fileutil, lazfileutils;
|
||||
|
||||
{ TWinePathConverter }
|
||||
|
||||
{$IFDEF UNIX}
|
||||
procedure TWinePathConverter.FillMap;
|
||||
|
||||
Var
|
||||
DriveLink,DevicesDir : String;
|
||||
drive : Char;
|
||||
|
||||
begin
|
||||
|
||||
DevicesDir:=GetUserDir+'.wine/dosdevices/';
|
||||
if not DirectoryExists(DevicesDir,True) then
|
||||
exit;
|
||||
for drive:='a' to 'z' do
|
||||
begin
|
||||
DriveLink:=DevicesDir+Drive+':';
|
||||
if DirectoryExists(DriveLink) then
|
||||
FMap.Add(Drive+':='+IncludeTrailingPathDelimiter(fpReadLink(DriveLink)));
|
||||
end;
|
||||
end;
|
||||
{$ELSE}
|
||||
procedure TWinePathConverter.FillMap;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
constructor TWinePathConverter.Create;
|
||||
begin
|
||||
FMap:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TWinePathConverter.Destroy;
|
||||
begin
|
||||
FreeAndNil(FMap);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TWinePathConverter.UnixToWindows(const aFileName: String): String;
|
||||
|
||||
function SubDirOf(const aBaseDir,aDestDir : string) : Boolean;
|
||||
|
||||
Var
|
||||
relPath : String;
|
||||
|
||||
begin
|
||||
relPath:=ExtractRelativePath(aBaseDir,aFileName);
|
||||
Result:=Copy(relPath,1,3)<>'../';
|
||||
end;
|
||||
|
||||
function FileBelowDir(const aBaseDir,aDestFile : String) : Boolean;
|
||||
|
||||
Var
|
||||
relPath : String;
|
||||
|
||||
begin
|
||||
relPath:=ExtractRelativePath(aBaseDir,aDestFile);
|
||||
Result:=Copy(relPath,1,3)<>'../';
|
||||
end;
|
||||
|
||||
|
||||
Var
|
||||
relPath,Drive,DriveDir,CurDrive,CurDir : String;
|
||||
i : Integer;
|
||||
|
||||
begin
|
||||
if FMap.Count=0 then
|
||||
FillMap;
|
||||
CurDrive:='';
|
||||
CurDir:='';
|
||||
for I:=0 to FMap.Count-1 do
|
||||
begin
|
||||
FMap.GetNameValue(I,Drive,DriveDir);
|
||||
if FileBelowDir(DriveDir,aFileName) then
|
||||
begin
|
||||
if (CurDir='') or (SubDirOf(CurDir,DriveDir)) then
|
||||
begin
|
||||
CurDrive:=Drive;
|
||||
CurDir:=DriveDir
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if CurDrive<>'' then
|
||||
begin
|
||||
relPath:=ExtractRelativePath(DriveDir,aFileName);
|
||||
Result:=UpperCase(CurDrive)+StringReplace(relPath,'/','\',[rfReplaceAll]);
|
||||
end
|
||||
else
|
||||
Result:=StringReplace(relPath,'/','\',[rfReplaceAll]);
|
||||
end;
|
||||
|
||||
function TWinePathConverter.WindowsToUnix(const aFileName: String): String;
|
||||
|
||||
var
|
||||
S : String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
if aFileName='' then exit;
|
||||
if (Length(aFileName)<2) or (aFileName[2]<>':') then
|
||||
Exit(aFileName);
|
||||
if FMap.Count=0 then
|
||||
FillMap;
|
||||
S:=LowerCase(aFileName[1]+':');
|
||||
S:=FMap.Values[S];
|
||||
if S<>'' then
|
||||
Result:=S+SetDirSeparators(Copy(aFileName,4))
|
||||
else
|
||||
Result:=SetDirSeparators(aFileName);
|
||||
Result:=StringReplace(Result,'\','/',[rfReplaceAll]);
|
||||
end;
|
||||
|
||||
{ TDelphiCompilerParser }
|
||||
|
||||
function TDelphiCompilerParser.CreateConverter: TWinePathConverter;
|
||||
begin
|
||||
Result:=TWinePathConverter.Create;
|
||||
end;
|
||||
|
||||
constructor TDelphiCompilerParser.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FConverter:=CreateConverter;
|
||||
|
||||
// filename(linenumber): E2003 Undeclared identifier: 'foo'
|
||||
FRegExprFilenameLineIDMsg:=TRegExpr.Create;
|
||||
FRegExprFilenameLineIDMsg.ModifierStr:='I';
|
||||
FRegExprFilenameLineIDMsg.Expression:='^(.*)\(([0-9]+)\): ([HNWEF])([0-9]+) (.*)$';
|
||||
|
||||
// filename(linenumber): Fatal: F2613 Unit 'Unit3' not found.
|
||||
FRegExprFilenameLineUrgencyIDMsg:=TRegExpr.Create;
|
||||
FRegExprFilenameLineUrgencyIDMsg.ModifierStr:='I';
|
||||
FRegExprFilenameLineUrgencyIDMsg.Expression:='^(.*)\(([0-9]+)\) ([a-zA-Z]+): ([HNWEF])([0-9]+) (.*)$';
|
||||
end;
|
||||
|
||||
destructor TDelphiCompilerParser.Destroy;
|
||||
begin
|
||||
FreeAndNil(FRegExprFilenameLineIDMsg);
|
||||
FreeAndNil(FRegExprFilenameLineUrgencyIDMsg);
|
||||
FreeAndNil(FConverter);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDelphiCompilerParser.ReadLine(Line: string; OutputIndex: integer;
|
||||
IsStdErr: boolean; var Handled: boolean);
|
||||
|
||||
procedure Add(const aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String);
|
||||
var
|
||||
MsgLine: TMessageLine;
|
||||
begin
|
||||
MsgLine:=CreateMsgLine(OutputIndex);
|
||||
case UrgencyLetter of
|
||||
'H': MsgLine.Urgency:=mluHint;
|
||||
'N': MsgLine.Urgency:=mluNote;
|
||||
'W': MsgLine.Urgency:=mluWarning;
|
||||
'E': MsgLine.Urgency:=mluError;
|
||||
'F': MsgLine.Urgency:=mluFatal;
|
||||
else MsgLine.Urgency:=mluImportant;
|
||||
end;
|
||||
if DelphiToolOptions.ConvertPathsToUnix then
|
||||
MsgLine.Filename:=FConverter.WindowsToUnix(aFilename)
|
||||
else
|
||||
MsgLine.Filename:=aFilename;
|
||||
MsgLine.Line:=StrToIntDef(LineNoStr,0);
|
||||
MsgLine.MsgID:=StrToIntDef(IDStr,0);
|
||||
MsgLine.Msg:=MsgStr;
|
||||
if IsStdErr then
|
||||
MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
|
||||
AddMsgLine(MsgLine);
|
||||
end;
|
||||
|
||||
procedure AddFilenameLineIDMsg;
|
||||
var
|
||||
RE: TRegExpr;
|
||||
aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String;
|
||||
begin
|
||||
RE:=FRegExprFilenameLineIDMsg;
|
||||
aFilename:=RE.Match[1];
|
||||
LineNoStr:=RE.Match[2];
|
||||
UrgencyLetter:=RE.Match[3];
|
||||
IDStr:=RE.Match[4];
|
||||
MsgStr:=RE.Match[5];
|
||||
Add(aFilename,LineNoStr,UrgencyLetter,IDStr,MsgStr);
|
||||
end;
|
||||
|
||||
procedure AddFilenameLineUrgencyIDMsg;
|
||||
var
|
||||
RE: TRegExpr;
|
||||
aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String;
|
||||
begin
|
||||
RE:=FRegExprFilenameLineUrgencyIDMsg;
|
||||
aFilename:=RE.Match[1];
|
||||
LineNoStr:=RE.Match[2];
|
||||
//UrgencyStr:=RE.Match[3];
|
||||
UrgencyLetter:=RE.Match[4];
|
||||
IDStr:=RE.Match[5];
|
||||
MsgStr:=RE.Match[6];
|
||||
Add(aFilename,LineNoStr,UrgencyLetter,IDStr,MsgStr);
|
||||
end;
|
||||
|
||||
procedure AddOtherLine;
|
||||
var
|
||||
MsgLine: TMessageLine;
|
||||
begin
|
||||
MsgLine:=CreateMsgLine(OutputIndex);
|
||||
MsgLine.MsgID:=0;
|
||||
MsgLine.SubTool:=SSubToolDelphi;
|
||||
if MsgLine.Msg<>'' then
|
||||
MsgLine.Urgency:=mluImportant
|
||||
else
|
||||
MsgLine.Urgency:=mluVerbose2;
|
||||
if IsStdErr then
|
||||
MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
|
||||
AddMsgLine(MsgLine);
|
||||
end;
|
||||
|
||||
begin
|
||||
FRegExprFilenameLineIDMsg.InputString:=Line;
|
||||
if FRegExprFilenameLineIDMsg.ExecPos(1) then
|
||||
begin
|
||||
AddFilenameLineIDMsg;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FRegExprFilenameLineUrgencyIDMsg.InputString:=Line;
|
||||
if FRegExprFilenameLineUrgencyIDMsg.ExecPos(1) then
|
||||
begin
|
||||
AddFilenameLineUrgencyIDMsg;
|
||||
exit;
|
||||
end;
|
||||
|
||||
AddOtherLine;
|
||||
|
||||
Handled:=true;
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.DefaultSubTool: string;
|
||||
begin
|
||||
Result:=SDelphiToolName;
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.GetParserName: string;
|
||||
begin
|
||||
Result:=SDelphiParserName;
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.GetLocalizedParserName: string;
|
||||
begin
|
||||
Result:=SDelphiLocalizedParserName;
|
||||
end;
|
||||
|
||||
|
||||
class function TDelphiCompilerParser.Priority: integer;
|
||||
begin
|
||||
Result:=SubToolDelphiPriority;
|
||||
end;
|
||||
|
||||
{ TDelphiTool }
|
||||
|
||||
function TDelphiTool.GetCompilerPath(const s: string; const Data: PtrInt;
|
||||
var Abort: boolean): string;
|
||||
begin
|
||||
Abort:=False;
|
||||
if (s<>'') and (ConsoleVerbosity>=0) then
|
||||
debugln(['Hint: (lazarus) [TDelphiTool.GetCompilerPath] ignoring macro DCC parameter "',s,'"']);
|
||||
Result:=GetParsedCompilerFilename;
|
||||
if Result='' then
|
||||
Result:='dcc32.exe'; // always return something to get nicer error messages
|
||||
debugln(['macro DCC parameter: "',Result,'"']);
|
||||
end;
|
||||
|
||||
function TDelphiTool.GetCompileCommand(const s: string; const Data: PtrInt;
|
||||
var Abort: boolean): string;
|
||||
begin
|
||||
if (s<>'') and (ConsoleVerbosity>=0) then
|
||||
debugln(['Hint: (lazarus) [TDelphiTool.GetCompilerPath] ignoring macro DELPHICOMPILE parameter "',s,'"']);
|
||||
Result:=GetCompileCommand();
|
||||
// debugln(['macro DELPHICOMPILE parameter: "',Result,'"']);
|
||||
end;
|
||||
|
||||
function TDelphiTool.GetCompilerArgs(const s: string; const Data: PtrInt;
|
||||
var Abort: boolean): string;
|
||||
|
||||
|
||||
begin
|
||||
|
||||
if (s<>'') and (ConsoleVerbosity>=0) then
|
||||
debugln(['Hint: (lazarus) [TDelphiTool.GetCompilerPath] ignoring macro DCCARGS parameter "',s,'"']);
|
||||
Result:=GetCompilerArguments;
|
||||
// debugln(['macro DCCARGS parameter: "',Result,'"']);
|
||||
end;
|
||||
|
||||
|
||||
function TDelphiTool.GetConfigPath(const s: string; const Data: PtrInt;
|
||||
var Abort: boolean): string;
|
||||
begin
|
||||
Abort:=False;
|
||||
if (s<>'') and (ConsoleVerbosity>=0) then
|
||||
debugln(['Hint: (lazarus) [TDelphiTool.GetConfigPath] ignoring macro DCCCONFIG parameter "',s,'"']);
|
||||
Result:=GetCurrentConfigFilename;
|
||||
if (Result='') then
|
||||
Result:='Project1'+DelphiOptions.DefaultConfigExtension;
|
||||
// debugln(['macro DCCCONFIG parameter: "',Result,'"']);
|
||||
end;
|
||||
|
||||
destructor TDelphiTool.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class constructor TDelphiTool.Init;
|
||||
begin
|
||||
_instance:=TDelphiTool.Create;
|
||||
end;
|
||||
|
||||
class destructor TDelphiTool.Done;
|
||||
begin
|
||||
FreeAndNil(_instance);
|
||||
end;
|
||||
|
||||
function TDelphiTool.FPCToDelphiOpts(Opts : TLazCompilerOptions; aDelphiOpts: TStrings) : Integer;
|
||||
|
||||
Procedure AddFlag(SetFlag : Boolean; const FlagName : String);
|
||||
|
||||
begin
|
||||
aDelphiOpts.Add('-$'+FlagName+PlusMinus[SetFlag]);
|
||||
Inc(Result);
|
||||
end;
|
||||
|
||||
procedure AddOption(DoAdd : Boolean; const Option : String);
|
||||
|
||||
begin
|
||||
if DoAdd then
|
||||
begin
|
||||
aDelphiOpts.Add('-'+Option);
|
||||
Inc(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddOption(aValue : String; const FlagName : String);
|
||||
|
||||
begin
|
||||
AddOption(aValue<>'',FlagName+aValue);
|
||||
end;
|
||||
|
||||
begin
|
||||
// Options
|
||||
AddOption(Opts.GetUnitPath(False,coptParsed,True),'U');
|
||||
AddOPtion(Opts.GetIncludePath(False,coptParsed,True),'I');
|
||||
AddOption(Opts.GenerateDebugInfo,'V');
|
||||
AddOption(Opts.UnitOutputDirectory,'NU');
|
||||
AddOption(Opts.UnitOutputDirectory,'NO');
|
||||
AddOption(Opts.GetObjectPath(True,coptParsed,True),'O');
|
||||
AddOption(Opts.ShowWarn,'W');
|
||||
AddOption(Opts.ShowHints,'H');
|
||||
AddOption(Opts.DontUseConfigFile,'-no-config');
|
||||
AddOption(Opts.TargetFileExt,'TX');
|
||||
// Flags
|
||||
AddFlag(Opts.RangeChecks,'R');
|
||||
AddFlag(Opts.IOChecks,'I');
|
||||
AddFlag(Opts.IncludeAssertionCode,'C');
|
||||
AddFlag(Opts.UseAnsiStrings,'H');
|
||||
AddFlag(Opts.OptimizationLevel>0,'O');
|
||||
AddFlag(Opts.OverflowChecks,'Q');
|
||||
AddFlag(Opts.GenerateDebugInfo,'L');
|
||||
AddFlag(Opts.GenerateDebugInfo,'W');
|
||||
AddFlag(Opts.GenerateDebugInfo,'Y');
|
||||
// We can maybe check for -Sy in custom options ?
|
||||
end;
|
||||
|
||||
function TDelphiTool.GenerateConfigFilename(const aFilename : String) : Boolean;
|
||||
|
||||
var
|
||||
Opts : TLazCompilerOptions;
|
||||
BuildID: String;
|
||||
Idx : Integer;
|
||||
L : TStrings;
|
||||
|
||||
begin
|
||||
debugln(['Generating delphi project configuration file: "',aFileName,'"']);
|
||||
BuildID:=LazarusIDE.ActiveProject.ActiveBuildModeID;
|
||||
Idx:=LazarusIDE.ActiveProject.LazBuildModes.IndexOf(BuildID);
|
||||
if Idx<0 then
|
||||
Idx:=0;
|
||||
Opts:=LazarusIDE.ActiveProject.LazBuildModes.BuildModes[Idx].LazCompilerOptions;
|
||||
L:=TstringList.Create;
|
||||
try
|
||||
Result:=FPCToDelphiOpts(Opts,L)>0;
|
||||
L.SaveToFile(aFileName);
|
||||
debugln(['Generated delphi project configuration file: "',aFileName,'"']);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDelphiTool.OnProjectBuilding(Sender: TObject): TModalResult;
|
||||
|
||||
begin
|
||||
Result:=mrOK;
|
||||
FMacros[dmCompiler].LazbuildValue:=GetCompileCommand();
|
||||
FMacros[dmConfigFileName].LazbuildValue:=GetCurrentConfigFileName;
|
||||
FMacros[dmCompileCommand].LazbuildValue:=GetCompileCommand;
|
||||
FMacros[dmAdditionalArgs].LazbuildValue:=GetCompilerArguments;
|
||||
if DelphiToolOptions.GenerateConfigFile and assigned(LazarusIDE.ActiveProject) then
|
||||
GenerateConfigFilename(GetCurrentConfigFileName(False));
|
||||
end;
|
||||
|
||||
procedure TDelphiTool.Hook;
|
||||
begin
|
||||
FMacros[dmCompiler]:=IDEMacros.Add('DCC', '', SDelphiCompilerFileNameCaption, @GetCompilerPath, [tmfLazbuild]);
|
||||
FMacros[dmConfigFileName]:=IDEMacros.Add('DCCCONFIG', '', SDelphiCompilerConfigFileName, @GetConfigPath, [tmfLazbuild]);
|
||||
FMacros[dmCompileCommand]:=IDEMacros.Add('DELPHICOMPILE', '', SDelphiCompileCommand, @GetCompileCommand, [tmfLazbuild]);
|
||||
FMacros[dmAdditionalArgs]:=IDEMacros.Add('DCCARGS', '', SDelphiCompilerArgs, @GetCompilerArgs, [tmfLazbuild]);
|
||||
LazarusIDE.AddHandlerOnProjectBuilding(@OnProjectBuilding);
|
||||
end;
|
||||
|
||||
procedure TDelphiTool.UnHook;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
function TDelphiTool.GetParsedCompilerFilename: String;
|
||||
|
||||
begin
|
||||
Result:=DelphiToolOptions.CompilerFileName;
|
||||
IDEMacros.SubstituteMacros(Result);
|
||||
if not FilenameIsAbsolute(Result) then
|
||||
Result:=FindDefaultExecutablePath(Result);
|
||||
end;
|
||||
|
||||
function TDelphiTool.GetCurrentConfigFileName(PrependAt: Boolean = True): String;
|
||||
begin
|
||||
if Assigned(LazarusIDE.ActiveProject) and DelphiToolOptions.GenerateConfigFile then
|
||||
begin
|
||||
Result:=ChangeFileExt(LazarusIDE.ActiveProject.ProjectInfoFile,DelphiOptions.DefaultConfigExtension);
|
||||
if PrependAt then
|
||||
Result:='@'+Result;
|
||||
end
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TDelphiTool.GetCompilerArguments: string;
|
||||
begin
|
||||
Result:=DelphiToolOptions.AdditionalOptions;
|
||||
IDEMacros.SubstituteMacros(Result);
|
||||
end;
|
||||
|
||||
|
||||
function TDelphiTool.GetCompileCommand: string;
|
||||
|
||||
begin
|
||||
Result:='$(DCC) $(DCCARGS) $(DCCCONFIG)';
|
||||
IDEMacros.SubstituteMacros(Result);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
137
components/compilers/delphi/fradelphioptions.lfm
Normal file
137
components/compilers/delphi/fradelphioptions.lfm
Normal file
@ -0,0 +1,137 @@
|
||||
object DelphiOptionsFrame: TDelphiOptionsFrame
|
||||
Left = 0
|
||||
Height = 334
|
||||
Top = 0
|
||||
Width = 624
|
||||
ClientHeight = 334
|
||||
ClientWidth = 624
|
||||
TabOrder = 0
|
||||
DesignLeft = 762
|
||||
DesignTop = 448
|
||||
object lblDelphiPath: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 16
|
||||
Height = 16
|
||||
Top = 8
|
||||
Width = 164
|
||||
BorderSpacing.Left = 16
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Delphi compiler executable'
|
||||
ParentColor = False
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
end
|
||||
object cbDelphiPath: TComboBox
|
||||
AnchorSideLeft.Control = lblDelphiPath
|
||||
AnchorSideTop.Control = lblDelphiPath
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Pas2jsPathBrowseButton
|
||||
Left = 16
|
||||
Height = 27
|
||||
Top = 32
|
||||
Width = 577
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 8
|
||||
ItemHeight = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object Pas2jsPathBrowseButton: TButton
|
||||
AnchorSideTop.Control = cbDelphiPath
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = cbDelphiPath
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 593
|
||||
Height = 27
|
||||
Top = 32
|
||||
Width = 23
|
||||
Anchors = [akTop, akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 8
|
||||
Caption = '...'
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 1
|
||||
end
|
||||
object cbGenConfig: TCheckBox
|
||||
AnchorSideLeft.Control = lblDelphiPath
|
||||
AnchorSideTop.Control = cbDelphiPath
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 67
|
||||
Width = 377
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Generate Delphi config file based on FPC compiler options'
|
||||
TabOrder = 2
|
||||
end
|
||||
object cbConfigFileExtension: TComboBox
|
||||
AnchorSideLeft.Control = lblConfigFileExtension
|
||||
AnchorSideTop.Control = lblConfigFileExtension
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 27
|
||||
Top = 122
|
||||
Width = 136
|
||||
BorderSpacing.Top = 8
|
||||
ItemHeight = 0
|
||||
TabOrder = 3
|
||||
end
|
||||
object lblConfigFileExtension: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbGenConfig
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 16
|
||||
Top = 98
|
||||
Width = 170
|
||||
BorderSpacing.Left = 16
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Configuration file extension'
|
||||
ParentColor = False
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
end
|
||||
object cbConvertDosToUnix: TCheckBox
|
||||
AnchorSideLeft.Control = lblDelphiPath
|
||||
AnchorSideTop.Control = cbConfigFileExtension
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 157
|
||||
Width = 306
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Map filenames from Windows to Unix notation'
|
||||
TabOrder = 4
|
||||
end
|
||||
object lblAdditionalOptions: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbConvertDosToUnix
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 16
|
||||
Top = 188
|
||||
Width = 167
|
||||
BorderSpacing.Left = 16
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Additional compiler options'
|
||||
ParentColor = False
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
end
|
||||
object cbAdditionalOptions: TComboBox
|
||||
AnchorSideLeft.Control = lblAdditionalOptions
|
||||
AnchorSideTop.Control = lblAdditionalOptions
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Pas2jsPathBrowseButton
|
||||
Left = 16
|
||||
Height = 27
|
||||
Top = 212
|
||||
Width = 577
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 8
|
||||
ItemHeight = 0
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
96
components/compilers/delphi/fradelphioptions.pas
Normal file
96
components/compilers/delphi/fradelphioptions.pas
Normal file
@ -0,0 +1,96 @@
|
||||
unit fradelphioptions;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, StdCtrls,
|
||||
// LazUtils
|
||||
LazFileCache, LazFileUtils, LazStringUtils, FileUtil,
|
||||
// IdeIntf
|
||||
IDEOptionsIntf, IDEOptEditorIntf, IDEUtils, IDEDialogs,
|
||||
DelphiOptions;
|
||||
|
||||
type
|
||||
|
||||
{ TDelphiOptionsFrame }
|
||||
|
||||
TDelphiOptionsFrame = class(TAbstractIDEOptionsEditor)
|
||||
cbConfigFileExtension: TComboBox;
|
||||
cbAdditionalOptions: TComboBox;
|
||||
cbGenConfig: TCheckBox;
|
||||
cbConvertDosToUnix: TCheckBox;
|
||||
lblConfigFileExtension: TLabel;
|
||||
lblAdditionalOptions: TLabel;
|
||||
Pas2jsPathBrowseButton: TButton;
|
||||
cbDelphiPath: TComboBox;
|
||||
lblDelphiPath: TLabel;
|
||||
private
|
||||
|
||||
public
|
||||
function GetTitle: String; override;
|
||||
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
|
||||
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
|
||||
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses strdelphitool;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TDelphiOptionsFrame }
|
||||
|
||||
function TDelphiOptionsFrame.GetTitle: String;
|
||||
begin
|
||||
Result:=SDelphiToolOptionsTitle;
|
||||
end;
|
||||
|
||||
procedure TDelphiOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
|
||||
begin
|
||||
lblDelphiPath.Caption:=SDelphiCompilerFileNameCaption;
|
||||
lblConfigFileExtension.Caption:=SConfigFileExtensionCaption;
|
||||
cbGenConfig.Caption:=SGenerateConfigFileCaption;
|
||||
cbConvertDosToUnix.Caption:=SConvertDosToUnixCaption;
|
||||
cbConvertDosToUnix.Enabled:={$IFDEF UNIX}True{$ELSE}False{$ENDIF};
|
||||
lblAdditionalOptions.Caption:=SDelphiCompilerArgs;
|
||||
end;
|
||||
|
||||
procedure TDelphiOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
|
||||
|
||||
var
|
||||
Opts : TDelphiToolOptions;
|
||||
|
||||
begin
|
||||
Opts:=DelphiToolOptions;
|
||||
cbGenConfig.Checked:=Opts.GenerateConfigFile;
|
||||
cbConvertDosToUnix.Checked:=Opts.ConvertPathsToUnix;
|
||||
cbDelphiPath.Text:=Opts.CompilerFileName;
|
||||
cbConfigFileExtension.Text:=Opts.ConfigFileExtension;
|
||||
cbAdditionalOptions.Text:=Opts.AdditionalOptions;
|
||||
end;
|
||||
|
||||
procedure TDelphiOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
|
||||
var
|
||||
Opts : TDelphiToolOptions;
|
||||
|
||||
begin
|
||||
Opts:=DelphiToolOptions;
|
||||
Opts.GenerateConfigFile:=cbGenConfig.Checked;
|
||||
Opts.ConvertPathsToUnix:=cbConvertDosToUnix.Checked;
|
||||
Opts.CompilerFileName:=cbDelphiPath.Text;
|
||||
Opts.ConfigFileExtension:=cbConfigFileExtension.Text;
|
||||
Opts.AdditionalOptions:=cbAdditionalOptions.Text;
|
||||
Opts.Save;
|
||||
end;
|
||||
|
||||
class function TDelphiOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
|
||||
begin
|
||||
Result:=IDEEditorGroups.GetByIndex(GroupEnvironment)^.GroupClass;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -13,7 +13,23 @@
|
||||
<Item>
|
||||
<Filename Value="lazdelphireg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="lazdelphireg"/>
|
||||
<UnitName Value="LazDelphiReg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="delphitool.pas"/>
|
||||
<UnitName Value="delphitool"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="fradelphioptions.pas"/>
|
||||
<UnitName Value="fradelphioptions"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="strdelphitool.pas"/>
|
||||
<UnitName Value="strdelphitool"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Filename Value="delphioptions.pas"/>
|
||||
<UnitName Value="delphioptions"/>
|
||||
</Item>
|
||||
</Files>
|
||||
<RequiredPkgs>
|
||||
|
||||
@ -8,7 +8,8 @@ unit LazDelphi;
|
||||
interface
|
||||
|
||||
uses
|
||||
LazDelphiReg, LazarusPackageIntf;
|
||||
LazDelphiReg, delphitool, fradelphioptions, strdelphitool, delphioptions,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -5,178 +5,31 @@ unit LazDelphiReg;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, IDEExternToolIntf, RegExpr;
|
||||
|
||||
const
|
||||
SubToolDelphi = 'Delphi';
|
||||
SubToolDelphiPriority = SubToolFPCPriority-10;
|
||||
|
||||
type
|
||||
|
||||
{ TDelphiCompilerParser }
|
||||
|
||||
TDelphiCompilerParser = class(TExtToolParser)
|
||||
private
|
||||
protected
|
||||
FRegExprFilenameLineIDMsg: TRegExpr;
|
||||
FRegExprFilenameLineUrgencyIDMsg: TRegExpr;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ReadLine(Line: string; OutputIndex: integer; IsStdErr: boolean;
|
||||
var Handled: boolean); override; // (worker thread)
|
||||
class function DefaultSubTool: string; override;
|
||||
class function GetParserName: string; override;
|
||||
class function GetLocalizedParserName: string; override;
|
||||
class function Priority: integer; override;
|
||||
end;
|
||||
TDelphiCompilerParserClass = class of TDelphiCompilerParser;
|
||||
Classes, SysUtils, IDEIntf, IDEOptionsIntf, IDEOptEditorIntf, IDEExternToolIntf, delphitool, fradelphioptions;
|
||||
|
||||
var
|
||||
IDEDelphiCompilerParserClass: TDelphiCompilerParserClass = nil;
|
||||
IDEDelphiCompilerParserClass : TDelphiCompilerParserClass = nil;
|
||||
|
||||
var
|
||||
DelphiToolsFrameID: integer = 1001;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses delphioptions;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
ExternalToolList.RegisterParser(TDelphiCompilerParser);
|
||||
if IDEDelphiCompilerParserClass=Nil then
|
||||
IDEDelphiCompilerParserClass:=TDelphiCompilerParser;
|
||||
ExternalToolList.RegisterParser(IDEDelphiCompilerParserClass);
|
||||
DelphiToolsFrameID:=RegisterIDEOptionsEditor( GroupEnvironment,TDelphiOptionsFrame, DelphiToolsFrameID)^.Index;
|
||||
DelphiToolOptions.Load;
|
||||
TDelphiTool.Instance.Hook;
|
||||
|
||||
end;
|
||||
|
||||
{ TDelphiCompilerParser }
|
||||
|
||||
constructor TDelphiCompilerParser.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
// filename(linenumber): E2003 Undeclared identifier: 'foo'
|
||||
FRegExprFilenameLineIDMsg:=TRegExpr.Create;
|
||||
FRegExprFilenameLineIDMsg.ModifierStr:='I';
|
||||
FRegExprFilenameLineIDMsg.Expression:='^(.*)\(([0-9]+)\): ([HNWEF])([0-9]+) (.*)$';
|
||||
|
||||
// filename(linenumber): Fatal: F2613 Unit 'Unit3' not found.
|
||||
FRegExprFilenameLineUrgencyIDMsg:=TRegExpr.Create;
|
||||
FRegExprFilenameLineUrgencyIDMsg.ModifierStr:='I';
|
||||
FRegExprFilenameLineUrgencyIDMsg.Expression:='^(.*)\(([0-9]+)\) ([a-zA-Z]+): ([HNWEF])([0-9]+) (.*)$';
|
||||
end;
|
||||
|
||||
destructor TDelphiCompilerParser.Destroy;
|
||||
begin
|
||||
FreeAndNil(FRegExprFilenameLineIDMsg);
|
||||
FreeAndNil(FRegExprFilenameLineUrgencyIDMsg);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDelphiCompilerParser.ReadLine(Line: string; OutputIndex: integer;
|
||||
IsStdErr: boolean; var Handled: boolean);
|
||||
|
||||
procedure Add(const aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String);
|
||||
var
|
||||
MsgLine: TMessageLine;
|
||||
begin
|
||||
MsgLine:=CreateMsgLine(OutputIndex);
|
||||
case UrgencyLetter of
|
||||
'H': MsgLine.Urgency:=mluHint;
|
||||
'N': MsgLine.Urgency:=mluNote;
|
||||
'W': MsgLine.Urgency:=mluWarning;
|
||||
'E': MsgLine.Urgency:=mluError;
|
||||
'F': MsgLine.Urgency:=mluFatal;
|
||||
else MsgLine.Urgency:=mluImportant;
|
||||
end;
|
||||
MsgLine.Filename:=aFilename;
|
||||
MsgLine.Line:=StrToIntDef(LineNoStr,0);
|
||||
MsgLine.MsgID:=StrToIntDef(IDStr,0);
|
||||
MsgLine.Msg:=MsgStr;
|
||||
if IsStdErr then
|
||||
MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
|
||||
AddMsgLine(MsgLine);
|
||||
end;
|
||||
|
||||
procedure AddFilenameLineIDMsg;
|
||||
var
|
||||
RE: TRegExpr;
|
||||
aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String;
|
||||
begin
|
||||
RE:=FRegExprFilenameLineIDMsg;
|
||||
aFilename:=RE.Match[1];
|
||||
LineNoStr:=RE.Match[2];
|
||||
UrgencyLetter:=RE.Match[3];
|
||||
IDStr:=RE.Match[4];
|
||||
MsgStr:=RE.Match[5];
|
||||
Add(aFilename,LineNoStr,UrgencyLetter,IDStr,MsgStr);
|
||||
end;
|
||||
|
||||
procedure AddFilenameLineUrgencyIDMsg;
|
||||
var
|
||||
RE: TRegExpr;
|
||||
aFilename, LineNoStr, UrgencyLetter, IDStr, MsgStr: String;
|
||||
begin
|
||||
RE:=FRegExprFilenameLineUrgencyIDMsg;
|
||||
aFilename:=RE.Match[1];
|
||||
LineNoStr:=RE.Match[2];
|
||||
//UrgencyStr:=RE.Match[3];
|
||||
UrgencyLetter:=RE.Match[4];
|
||||
IDStr:=RE.Match[5];
|
||||
MsgStr:=RE.Match[6];
|
||||
Add(aFilename,LineNoStr,UrgencyLetter,IDStr,MsgStr);
|
||||
end;
|
||||
|
||||
procedure AddOtherLine;
|
||||
var
|
||||
MsgLine: TMessageLine;
|
||||
begin
|
||||
MsgLine:=CreateMsgLine(OutputIndex);
|
||||
MsgLine.MsgID:=0;
|
||||
MsgLine.SubTool:=SubToolDelphi;
|
||||
if MsgLine.Msg<>'' then
|
||||
MsgLine.Urgency:=mluImportant
|
||||
else
|
||||
MsgLine.Urgency:=mluVerbose2;
|
||||
if IsStdErr then
|
||||
MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
|
||||
AddMsgLine(MsgLine);
|
||||
end;
|
||||
|
||||
begin
|
||||
FRegExprFilenameLineIDMsg.InputString:=Line;
|
||||
if FRegExprFilenameLineIDMsg.ExecPos(1) then
|
||||
begin
|
||||
AddFilenameLineIDMsg;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FRegExprFilenameLineUrgencyIDMsg.InputString:=Line;
|
||||
if FRegExprFilenameLineUrgencyIDMsg.ExecPos(1) then
|
||||
begin
|
||||
AddFilenameLineUrgencyIDMsg;
|
||||
exit;
|
||||
end;
|
||||
|
||||
AddOtherLine;
|
||||
|
||||
Handled:=true;
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.DefaultSubTool: string;
|
||||
begin
|
||||
Result:='DCC';
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.GetParserName: string;
|
||||
begin
|
||||
Result:='Delphi Compiler';
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.GetLocalizedParserName: string;
|
||||
begin
|
||||
Result:='Delphi Compiler';
|
||||
end;
|
||||
|
||||
class function TDelphiCompilerParser.Priority: integer;
|
||||
begin
|
||||
Result:=SubToolDelphiPriority;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
43
components/compilers/delphi/strdelphitool.pas
Normal file
43
components/compilers/delphi/strdelphitool.pas
Normal file
@ -0,0 +1,43 @@
|
||||
unit strdelphitool;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
const
|
||||
PlusMinus : Array[Boolean] of char = ('-','+');
|
||||
|
||||
|
||||
const
|
||||
// General
|
||||
DelphiToolsOptionsFile = 'delphitooloptions.xml';
|
||||
SDelphiToolName = 'DCC';
|
||||
SSubToolDelphi = 'Delphi';
|
||||
SDelphiParserName = 'Delphi Compiler';
|
||||
|
||||
// Settings
|
||||
KeyCompiler = 'compiler/value';
|
||||
KeyGenConfigFile = 'genconfigfile/value';
|
||||
KeyConfigFileExt = 'configfileext/value';
|
||||
KeyConvertPaths = 'convertunixpath/value';
|
||||
|
||||
|
||||
resourcestring
|
||||
SDelphiLocalizedParserName = 'Delphi Compiler';
|
||||
SDelphiToolOptionsTitle = 'Delphi compiler plugin options';
|
||||
SDelphiCompilerFileNameCaption = 'Delphi compiler executable';
|
||||
SConfigFileExtensionCaption = 'Configuration file extension';
|
||||
SGenerateConfigFileCaption = 'Generate Delphi config file based on FPC compiler options';
|
||||
SConvertDosToUnixCaption = 'Map filenames from Windows to Unix notation';
|
||||
SDelphiCompilerConfigFileName = 'Delphi compiler configuration filename for project';
|
||||
SDelphiCompileCommand = 'Delphi compile command';
|
||||
SDelphiCompilerArgs = 'Additional compiler options';
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user