IDE: further migration external tools

git-svn-id: trunk@42247 -
2025-12-10 00:17:18 +01:00 · 2013-07-31 13:54:49 +00:00 · 2013-07-31 13:54:49 +00:00 · 97ff736947
commit 97ff736947
parent 91fa76f1e4
6 changed files with 141 additions and 74 deletions
--- 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
--- 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 }
--- 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"');
--- 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
--- 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;
--- 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;