diff --git a/components/ideintf/ideexterntoolintf.pas b/components/ideintf/ideexterntoolintf.pas index 137da40298..8c6a08e28e 100644 --- a/components/ideintf/ideexterntoolintf.pas +++ b/components/ideintf/ideexterntoolintf.pas @@ -740,7 +740,7 @@ end; function TAbstractExternalTool.GetCmdLineParams: string; begin - + Result:=MergeCmdLineParams(Process.Parameters); end; function TAbstractExternalTool.GetParsers(Index: integer): TExtToolParser; @@ -759,7 +759,7 @@ var begin sl:=TStringList.Create; try - SplitCmdLineParams(aParams,sl,PathDelim<>'\'); + SplitCmdLineParams(aParams,sl); Process.Parameters:=sl; finally sl.Free; @@ -1961,6 +1961,7 @@ begin EnterCriticalSection; try if Running then exit; + if (Tool<>nil) and (Tool.Stage<>etsStopped) then exit; if PendingLines.Count>0 then exit; Result:=true; finally diff --git a/components/ideintf/idemsgintf.pas b/components/ideintf/idemsgintf.pas index 037d54f4c4..45ee1325a0 100644 --- a/components/ideintf/idemsgintf.pas +++ b/components/ideintf/idemsgintf.pas @@ -60,6 +60,34 @@ type var MsgQuickFixes: TMsgQuickFixes = nil; // set by IDE +type + TIDEMessagesWindowInterface = class(TForm) + protected + function GetViews(Index: integer): TExtToolView; virtual; abstract; + public + procedure Clear; virtual; abstract; // clears all finished views + + function ViewCount: integer; virtual; abstract; + property Views[Index: integer]: TExtToolView read GetViews; + function GetView(aCaption: string; CreateIfNotExist: boolean): TExtToolView; virtual; abstract; + function FindUnfinishedView: TExtToolView; virtual; abstract; + procedure DeleteView(View: TExtToolView); virtual; abstract; // free view + function IndexOfView(View: TExtToolView): integer; virtual; abstract; + + function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency; + WithSrcPos: boolean): boolean; virtual; abstract; + function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency; + WithSrcPos, Downwards: boolean): boolean; virtual; abstract; + + function AddCustomMessage(TheUrgency: TMessageLineUrgency; Msg: string; + aFilename: string = ''; LineNumber: integer = 0; Column: integer = 0; + const ViewCaption: string = ''): TMessageLine; virtual; abstract; + function GetSelectedLine: TMessageLine; virtual; abstract; + end; + +var + IDEMessagesWindow: TIDEMessagesWindowInterface = nil;// initialized by the IDE + implementation { TMsgQuickFix } diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp index 386f16c74e..9fb512c1b5 100644 --- a/ide/compileroptions.pp +++ b/ide/compileroptions.pp @@ -50,6 +50,9 @@ uses IDEOptionsIntf, // IDE LazarusIDEStrConsts, IDEProcs, IDEMsgIntf, LazConf, TransferMacros, + {$IFDEF EnableNewExtTools} + etFPCMsgParser, + {$ENDIF} ModeMatrixOpts, CompOptsModes, EnvironmentOpts; type @@ -730,6 +733,14 @@ implementation const CompilerOptionsVersion = 11; + {$IFDEF EnableNewExtTools} + etNone = mluNone; + etHint = mluHint; + etNote = mluNote; + etWarning = mluWarning; + etError = mluError; + etFatal = mluFatal; + {$ENDIF} function EnumToStr(opt: TParsedCompilerOptString): string; begin @@ -4198,7 +4209,19 @@ begin Tool:=ExternalToolList.Add(ToolTitle); Tool.Process.Executable:=ProgramFilename; Tool.Process.CurrentDirectory:=WorkingDir; - Tool.Process.Parameters; + Tool.CmdLineParams:=Params; + if ScanForFPCMessages then + Tool.AddParsers(SubToolFPC); + if ScanForMakeMessages then + Tool.AddParsers(SubToolMake); + if ShowAllMessages then + Tool.AddParsers(SubToolDefault); + Tool.Execute; + Tool.WaitForExit; + if Tool.ErrorMessage<>'' then + Result:=mrCancel + else + Result:=mrOk; {$ELSE} ExtTool:=TIDEExternalToolOptions.Create; try @@ -4592,7 +4615,7 @@ begin Result := fItems.Count; end; -function TCompilerMessagesList.GetErrorNames(errtype: TFPCErrorType): string; +function TCompilerMessagesList.GetErrorNames(errtype: {$IFDEF EnableNewExtTools}TMessageLineUrgency{$ELSE}TFPCErrorType{$ENDIF}): string; begin Result := FErrorNames[errtype]; end; @@ -4634,7 +4657,7 @@ procedure TCompilerMessagesList.Assign(Src: TCompilerMessagesList); var i : Integer; m : TCompilerMessageConfig; - err : TFPCErrorType; + err : {$IFDEF EnableNewExtTools}TMessageLineUrgency{$ELSE}TFPCErrorType{$ENDIF}; begin if Equals(Src) then Exit; @@ -4723,6 +4746,12 @@ function TCompilerMessagesList.LoadMsgFile(const FileName: string): Boolean; else Result := s; end; + {$IFDEF EnableNewExtTools} + function StrToErrType(const msgtype: String): TMessageLineUrgency; + begin + Result:=FPCMsgTypeToUrgency(msgtype); + end; + {$ELSE} function StrToErrType(const msgtype: String): TFPCErrorType; begin if length(msgtype)<>1 then @@ -4738,6 +4767,7 @@ function TCompilerMessagesList.LoadMsgFile(const FileName: string): Boolean; Result:=etNone; end; end; + {$ENDIF} var temp : TStringList; @@ -4749,7 +4779,7 @@ var i : Integer; lst : Boolean; b : array of TCompilerMessageState; - err : TFPCErrorType; + err : {$IFDEF EnableNewExtTools}TMessageLineUrgency{$ELSE}TFPCErrorType{$ENDIF}; const idxFatal = 01012; idxError = 01013; @@ -4782,15 +4812,15 @@ begin if (midx >= idxFatal) and (midx<= idxHint) then begin case midx of - idxFatal: err := etFatal; - idxError: err := etError; - idxWarning: err := etWarning; - idxNote: err := etNote; - idxHint: err := etHint; + idxFatal: err := {$IFDEF EnableNewExtTools}mluFatal{$ELSE}etFatal{$ENDIF}; + idxError: err := {$IFDEF EnableNewExtTools}mluError{$ELSE}etError{$ENDIF}; + idxWarning: err := {$IFDEF EnableNewExtTools}mluWarning{$ELSE}etWarning{$ENDIF}; + idxNote: err := {$IFDEF EnableNewExtTools}mluNote{$ELSE}etNote{$ENDIF}; + idxHint: err := {$IFDEF EnableNewExtTools}mluHint{$ELSE}etHint{$ENDIF}; else - err := etNone; + err := {$IFDEF EnableNewExtTools}mluNone{$ELSE}etNone{$ENDIF}; end; - if err <> etNone then begin + if err <> {$IFDEF EnableNewExtTools}mluNone{$ELSE}etNone{$ENDIF} then begin mtext := Trim(mtext); if (length(mtext)>1) and (mtext[length(mtext)]=':') then FErrorNames[err]:=Copy(mtext, 1, length(mtext)-1) @@ -4813,34 +4843,13 @@ begin Result := false; end; end; -{ -function IntToStrLen(i:Integer; len: integer; FillCh: Char = '0'): string; -var - s : string; - j : integer; -begin - if len <= 0 then begin - Result := ''; - Exit; - end; - s := IntToStr(i); - if length(s)>= len then - Result := s - else begin - SetLength(Result, len); - FillChar(Result[1], len, FillCh); - j := (len - length(s)) + 1; - Move(s[1], Result[j], length(s)); - end; -end; -} + function TCompilerMessagesList.Add(AMsgIndex: Integer; - AMsgType: TFPCErrorType; const AMsgText: string; DefIgnored: Boolean = false; + AMsgType: {$IFDEF EnableNewExtTools}TMessageLineUrgency{$ELSE}TFPCErrorType{$ENDIF}; + const AMsgText: string; DefIgnored: Boolean = false; AState: TCompilerMessageState = msDefault): TCompilerMessageConfig; var msgconf : TCompilerMessageConfig; -// prm : array of string; -// cnt : Integer; begin msgconf := FindHash(AMsgIndex); if not Assigned(msgConf) then begin @@ -4853,15 +4862,13 @@ begin msgconf.MsgText := AMsgText; msgconf.DefIgnored := DefIgnored; msgconf.State := AState; -// SetLength(prm, MaxMsgParams); -// GetParams(AMsgIndex, prm, cnt); Result := msgconf; end; procedure TCompilerMessagesList.SetDefault(KeepState: Boolean); var b : array of TCompilerMessageState; - err : TFPCErrorType; + err : {$IFDEF EnableNewExtTools}TMessageLineUrgency{$ELSE}TFPCErrorType{$ENDIF}; begin if KeepState then begin SetLength(b, MaxMsgIndex); @@ -4870,8 +4877,12 @@ begin BeginUpdate; try Clear; - for err := low(TFPCErrorType) to High(TFPCErrorType) do + for err := low(err) to High(err) do + {$IFDEF EnableNewExtTools} + FErrorNames[err]:=MessageLineUrgencyNames[err]; + {$ELSE} FErrorNames[err]:=FPCErrorTypeNames[err]; + {$ENDIF} Add(02005,etWarning,'Comment level $1 found'); Add(02008,etNote,'Ignored compiler switch "$1"'); diff --git a/ide/etfpcmsgparser.pas b/ide/etfpcmsgparser.pas index 08ccbc0b41..a9f3cdf72c 100644 --- a/ide/etfpcmsgparser.pas +++ b/ide/etfpcmsgparser.pas @@ -156,6 +156,7 @@ var FPCMsgFilePool: TFPCMsgFilePool = nil; function FPCMsgToMsgUrgency(Msg: TFPCMsgItem): TMessageLineUrgency; +function FPCMsgTypeToUrgency(const Typ: string): TMessageLineUrgency; function TranslateFPCMsg(const Src, SrcPattern, TargetPattern: string): string; function GetFPCMsgValue1(const Src, Pattern: string; out Value1: string): boolean; @@ -163,37 +164,36 @@ procedure RegisterFPCParser; implementation -function FPCMsgToMsgUrgency(Msg: TFPCMsgItem): TMessageLineUrgency; - - function TypToUrgency(const Typ: string): TMessageLineUrgency; - begin +function FPCMsgTypeToUrgency(const Typ: string): TMessageLineUrgency; +begin + Result:=mluNone; + if (Typ='') or (length(Typ)<>1) then exit; + case UpChars[Typ[1]] of + 'F': Result:=mluFatal; + 'E': Result:=mluError; + 'W': Result:=mluWarning; + 'N': Result:=mluNote; + 'H': Result:=mluHint; + 'I': Result:=mluVerbose; // info + 'L': Result:=mluProgress; // line number + 'C': Result:=mluVerbose; // conditional: like IFDEFs + 'U': Result:=mluVerbose2; // used: found files + 'T': Result:=mluVerbose3; // tried: tried paths, general information + 'D': Result:=mluDebug; + 'X': Result:=mluProgress; // e.g. Size of Code + 'O': Result:=mluProgress; // e.g., "press enter to continue" + else Result:=mluNone; - if (Typ='') or (length(Typ)<>1) then exit; - case UpChars[Typ[1]] of - 'F': Result:=mluFatal; - 'E': Result:=mluError; - 'W': Result:=mluWarn; - 'N': Result:=mluNote; - 'H': Result:=mluHint; - 'I': Result:=mluVerbose; // info - 'L': Result:=mluProgress; // line number - 'C': Result:=mluVerbose; // conditional: like IFDEFs - 'U': Result:=mluVerbose2; // used: found files - 'T': Result:=mluVerbose3; // tried: tried paths, general information - 'D': Result:=mluDebug; - 'X': Result:=mluProgress; // e.g. Size of Code - 'O': Result:=mluProgress; // e.g., "press enter to continue" - else - Result:=mluNone; - end; end; +end; +function FPCMsgToMsgUrgency(Msg: TFPCMsgItem): TMessageLineUrgency; begin Result:=mluNone; if Msg=nil then exit; - Result:=TypToUrgency(Msg.ShownTyp); + Result:=FPCMsgTypeToUrgency(Msg.ShownTyp); if Result<>mluNone then exit; - Result:=TypToUrgency(Msg.Typ); + Result:=FPCMsgTypeToUrgency(Msg.Typ); if Result=mluNone then begin //debugln(['FPCMsgToMsgUrgency Msg.ShownTyp="',Msg.ShownTyp,'" Msg.Typ="',Msg.Typ,'"']); Result:=mluVerbose3; @@ -846,7 +846,7 @@ begin else if ReadString(p,'Error: ') then MsgType:=mluError else if ReadString(p,'Warn: ') then - MsgType:=mluWarn + MsgType:=mluWarning else if ReadString(p,'Note: ') then MsgType:=mluNote else if ReadString(p,'Hint: ') then @@ -1036,7 +1036,7 @@ begin if CompStr('Closing script ppas.sh',p) then begin MsgLine:=CreateMsgLine; MsgLine.SubTool:=SubToolFPCLinker; - MsgLine.Urgency:=mluWarn; + MsgLine.Urgency:=mluWarning; MsgLine.Msg:=OldStart; AddMsgLine(MsgLine); exit(true); @@ -1047,7 +1047,7 @@ begin if CompStr('.o(',p) then begin MsgLine:=CreateMsgLine; MsgLine.SubTool:=SubToolFPCLinker; - MsgLine.Urgency:=mluWarn; + MsgLine.Urgency:=mluWarning; MsgLine.Msg:=OldStart; AddMsgLine(MsgLine); exit(true); @@ -1057,7 +1057,7 @@ begin Result:=true; MsgLine:=CreateMsgLine; MsgLine.SubTool:=SubToolFPCLinker; - MsgLine.Urgency:=mluWarn; + MsgLine.Urgency:=mluWarning; MsgLine.Msg:=OldStart; AddMsgLine(MsgLine); exit(true); @@ -1066,7 +1066,7 @@ begin Result:=true; MsgLine:=CreateMsgLine; MsgLine.SubTool:=SubToolFPCLinker; - MsgLine.Urgency:=mluWarn; + MsgLine.Urgency:=mluWarning; MsgLine.Msg:=OldStart; AddMsgLine(MsgLine); exit(true); @@ -1147,7 +1147,7 @@ begin Result:=true; MsgLine:=CreateMsgLine; MsgLine.SubTool:='windres'; - MsgLine.Urgency:=mluWarn; + MsgLine.Urgency:=mluWarning; p := wPos + 7; if CompStr('.exe', p) then inc(p, 4); @@ -1311,7 +1311,7 @@ begin end else if ReadString(p,'Note:') then begin MsgType:=mluNote; end else if ReadString(p,'Warn:') then begin - MsgType:=mluWarn; + MsgType:=mluWarning; end else if ReadString(p,'Error:') then begin MsgType:=mluError; end else if ReadString(p,'Fatal:') then begin diff --git a/ide/etmessageframe.pas b/ide/etmessageframe.pas index f46d3316d5..be6109a5f7 100644 --- a/ide/etmessageframe.pas +++ b/ide/etmessageframe.pas @@ -463,6 +463,8 @@ type MessagesCtrl: TMessagesCtrl; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; + + // Views function ViewCount: integer; property Views[Index: integer]: TLMsgWndView read GetViews; function GetView(aCaption: string; CreateIfNotExist: boolean): TLMsgWndView; @@ -470,10 +472,13 @@ type procedure DeleteView(View: TLMsgWndView); // free view function IndexOfView(View: TLMsgWndView): integer; procedure ClearViews; // deletes/frees all views + + // source marks procedure CreateMarksForFile(aSynEdit: TSynEdit; aFilename: string; DeleteOld: boolean); procedure ApplySrcChangeds(Changes: TETSrcChanges); - function GetDefaultSearchText: string; + + // message lines function SelectFirstUrgentMessage(aMinUrgency: TMessageLineUrgency; WithSrcPos: boolean): boolean; function SelectNextUrgentMessage(aMinUrgency: TMessageLineUrgency; @@ -481,6 +486,9 @@ type function AddCustomMessage(TheUrgency: TMessageLineUrgency; Msg: string; aFilename: string = ''; LineNumber: integer = 0; Column: integer = 0; const ViewCaption: string = CustomViewCaption): TMessageLine; + + // misc + function GetDefaultSearchText: string; end; function CompareHideMsgType(HideMsgType1, HideMsgType2: Pointer): integer; @@ -2496,7 +2504,7 @@ begin for i:=0 to ViewCount-1 do begin Result:=Views[i]; //debugln(['TMessagesCtrl.FindUnfinishedView ',i,' ',ViewCount,' caption="',Result.Caption,'" Result.Tool=',dbgsname(Result.Tool)]); - if (Result.Tool<>nil) and (Result.Tool.Stage<>etsStopped) then exit; + if not Result.HasFinished then exit; end; Result:=nil; end; diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index 08d86c1be5..a3b1a2c255 100644 --- a/packager/packagesystem.pas +++ b/packager/packagesystem.pas @@ -146,7 +146,11 @@ type function OpenDependencyWithPackageLink(Dependency: TPkgDependency; PkgLink: TPackageLink; ShowAbort: boolean): TModalResult; function DeleteAmbiguousFiles(const Filename: string): TModalResult; + {$IFDEF EnableNewExtTools} + procedure AddMessage(TheUrgency: TMessageLineUrgency; const Msg, Filename: string); + {$ELSE} procedure AddMessage(const Msg, Directory: string); + {$ENDIF} function OutputDirectoryIsWritable(APackage: TLazPackage; Directory: string; Verbose: boolean): boolean; function GetPackageCompilerParams(APackage: TLazPackage): string; @@ -640,6 +644,16 @@ begin Result:=mrOk; end; +{$IFDEF EnableNewExtTools} +procedure TLazPackageGraph.AddMessage(TheUrgency: TMessageLineUrgency; + const Msg, Filename: string); +begin + if Assigned(IDEMessagesWindow) then + IDEMessagesWindow.AddCustomMessage(TheUrgency,Msg,Filename) + else + DebugLn(['TLazPackageGraph.AddMessage ',MessageLineUrgencyNames[TheUrgency],' Msg="',Msg,'" Filename="',Filename,'"']); +end; +{$ELSE} procedure TLazPackageGraph.AddMessage(const Msg, Directory: string); begin if Assigned(IDEMessagesWindow) then @@ -647,6 +661,7 @@ begin else DebugLn(['TLazPackageGraph.AddMessage Msg="',Msg,'" Directory="',Directory,'"']); end; +{$ENDIF} function TLazPackageGraph.OutputDirectoryIsWritable(APackage: TLazPackage; Directory: string; Verbose: boolean): boolean; @@ -3316,7 +3331,11 @@ function TLazPackageGraph.CompilePackage(APackage: TLazPackage; end; var + {$IFDEF EnableNewExtTools} + PkgCompileTool: TAbstractExternalTool; + {$ELSE} PkgCompileTool: TIDEExternalToolOptions; + {$ENDIF} CompilerFilename: String; EffectiveCompilerParams: String; CompilePolicy: TPackageUpdatePolicy;