IDE: further migration external tools

git-svn-id: trunk@42326 -

components/ideintf/idemsgintf.pas

@@ -30,7 +30,7 @@ type
   protected
   public
     procedure CreateMenuItems(Fixes: TMsgQuickFixes); virtual;
-    procedure JumpTo({%H-}Msg: TMessageLine; var {%H-}Handled: boolean); virtual;
+    procedure JumpTo({%H-}Msg: TMessageLine; var {%H-}Handled: boolean); virtual; // called when user (double) clicks on message
     procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); virtual;
   end;
   TMsgQuickFixClass = class of TMsgQuickFix;
@@ -60,6 +60,8 @@ type
 var
   MsgQuickFixes: TMsgQuickFixes = nil; // set by IDE
 
+procedure RegisterIDEMsgQuickFix(Fix: TMsgQuickFix);
+
 type
   TIDEMessagesWindowInterface = class(TForm)
   protected
@@ -90,6 +92,11 @@ var
 
 implementation
 
+procedure RegisterIDEMsgQuickFix(Fix: TMsgQuickFix);
+begin
+  MsgQuickFixes.RegisterQuickFix(Fix);
+end;
+
 { TMsgQuickFix }
 
 procedure TMsgQuickFix.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine);

ide/codebrowser.pas

@@ -53,10 +53,12 @@ uses
   // IDEIntf
   IDEWindowIntf, SrcEditorIntf, IDEMsgIntf, IDEDialogs, LazConfigStorage,
   IDEHelpIntf, PackageIntf, TextTools, IDECommands, LazIDEIntf,
+  IDEExternToolIntf,
   // IDE
   Project, DialogProcs, PackageSystem, PackageDefs, LazarusIDEStrConsts,
   IDEOptionDefs,
   {$IFDEF EnableNewExtTools}
+  etFPCMsgParser,
   {$ELSE}
   MsgQuickFixes,
   {$ENDIF}
@@ -370,7 +372,19 @@ type
     property VisibleIdentifiers: PtrInt read FVisibleIdentifiers write SetVisibleIdentifiers;
     property UpdateNeeded: boolean read FUpdateNeeded write SetUpdateNeeded;
   end;
-  
+
+{$IFDEF EnableNewExtTools}
+type
+
+  { TQuickFixIdentifierNotFound_Search }
+
+  TQuickFixIdentifierNotFound_Search = class(TMsgQuickFix)
+  public
+    procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
+    procedure QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
+  end;
+{$ELSE}
+type
   { TQuickFixIdentifierNotFound_Search - add menu item to open codebrowser }
 
   TQuickFixIdentifierNotFound_Search = class(TIDEMsgQuickFixItem)
@@ -379,7 +393,7 @@ type
     function IsApplicable(Line: TIDEMessageLine): boolean; override;
     procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
   end;
-
+{$ENDIF}
 var
   CodeBrowserView: TCodeBrowserView = nil;
   
@@ -429,7 +443,7 @@ end;
 
 procedure InitCodeBrowserQuickFixItems;
 begin
-  RegisterIDEMsgQuickFix(TQuickFixIdentifierNotFound_Search.Create);
+  RegisterIDEMsgQuickFix(TQuickFixIdentifierNotFound_Search.Create{$IFDEF EnableNewExtTools}(nil){$ENDIF});
 end;
 
 procedure CreateCodeBrowser;
@@ -3206,6 +3220,73 @@ end;
 
 { TQuickFixIdentifierNotFound_Search }
 
+{$IFDEF EnableNewExtTools}
+procedure TQuickFixIdentifierNotFound_Search.CreateMenuItems(
+  Fixes: TMsgQuickFixes);
+var
+  Msg: TMessageLine;
+  Code: TCodeBuffer;
+begin
+  if Fixes.LineCount<>1 then exit;
+  Msg:=Fixes.Lines[0];
+  if not Msg.HasSourcePosition then exit;
+  if Msg.SubTool<>SubToolFPC then exit;
+  if Msg.MsgID<>5000 then exit;
+  Code:=CodeToolBoss.LoadFile(Msg.GetFullFilename,true,false);
+  if Code=nil then exit;
+  Fixes.AddMenuItem(Self,Msg,lisQuickFixSearchIdentifier);
+end;
+
+procedure TQuickFixIdentifierNotFound_Search.QuickFix(Fixes: TMsgQuickFixes;
+  Msg: TMessageLine);
+var
+  Identifier: String;
+  KnownFilename: String;
+  Caret: TPoint;
+  Filename: String;
+begin
+  if not Msg.HasSourcePosition then exit;
+  if not LazarusIDE.BeginCodeTools then begin
+    DebugLn(['TQuickFixIdentifierNotFound_Search.Execute failed because IDE busy']);
+    exit;
+  end;
+
+  // get identifier
+  if not REMatches(Msg.Msg,'Identifier not found "([a-z_0-9]+)"','I') then begin
+    DebugLn('TQuickFixIdentifierNotFound_Search invalid message ',Msg.Msg);
+    exit;
+  end;
+  Identifier:=REVar(1);
+  DebugLn(['TQuickFixIdentifierNotFound_Search.Execute Identifier=',Identifier]);
+
+  if (Identifier='') or (not IsValidIdent(Identifier)) then begin
+    DebugLn(['TQuickFixIdentifierNotFound_Search.Execute not an identifier "',dbgstr(Identifier),'"']);
+    exit;
+  end;
+
+  Filename:=Msg.GetFullFilename;
+  KnownFilename:= LazarusIDE.FindSourceFile(Filename, Project1.ProjectDirectory,
+                    [fsfSearchForProject, fsfUseIncludePaths, fsfMapTempToVirtualFiles]);
+  Caret:=Point(Msg.Line,Msg.Column);
+
+  if (KnownFilename <> '') and (KnownFilename <> Filename) then begin
+    if LazarusIDE.DoOpenFileAndJumpToPos(KnownFilename,Caret,-1,-1,-1,OpnFlagsPlainFile)<>mrOk
+    then
+    if LazarusIDE.DoOpenFileAndJumpToPos(Filename,Caret,-1,-1,-1,OpnFlagsPlainFile)<>mrOk
+    then exit;
+  end
+  else
+  if LazarusIDE.DoOpenFileAndJumpToPos(Filename,Caret,-1,-1,-1,OpnFlagsPlainFile
+    )<>mrOk
+  then exit;
+
+  // start code browser
+  CreateCodeBrowser;
+  CodeBrowserView.SetScopeToCurUnitOwner(true,true);
+  CodeBrowserView.SetFilterToSimpleIdentifier(Identifier);
+  IDEWindowCreators.ShowForm(CodeBrowserView,true);
+end;
+{$ELSE}
 constructor TQuickFixIdentifierNotFound_Search.Create;
 begin
   Name:='Search identifier: Error: Identifier not found "identifier"';
@@ -3291,6 +3372,7 @@ begin
     IDEWindowCreators.ShowForm(CodeBrowserView,true);
   end;
 end;
+{$ENDIF EnableNewExtTools}
 
 end.
 

ide/etmessageswnd.pas

@@ -31,7 +31,8 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, IDEMsgIntf, IDEImagesIntf, IDEExternToolIntf,
-  Forms, Controls, Graphics, Dialogs, etMessageFrame, etSrcEditMarks;
+  LazIDEIntf, Forms, Controls, Graphics, Dialogs, etMessageFrame,
+  etSrcEditMarks, etQuickFixes;
 
 type
 
@@ -50,8 +51,11 @@ type
     ImgIDWarning: integer;
     ImgIDError: integer;
     ImgIDFatal: integer;
+    function GetDblClickJumps: boolean;
+    procedure SetDblClickJumps(AValue: boolean);
   public
     SourceMarks: TETMarks;
+    property DblClickJumps: boolean read GetDblClickJumps write SetDblClickJumps;
   end;
 
 var
@@ -109,7 +113,28 @@ end;
 function TMessagesView.OnOpenMessage(Sender: TObject; Msg: TMessageLine
   ): boolean;
 begin
+  // ask quickfixes
+  if IDEQuickFixes.OpenMsg(Msg) then exit;
+  if Msg.GetFullFilename<>'' then begin
+    // ToDo: open file in source editor and mark it as error
+    LazarusIDE.DoOpenFileAndJumpToPos(Msg.GetFullFilename,
+      Point(Msg.Line,Msg.Column),-1,-1,-1,OpnFlagsPlainFile);
+  end;
+end;
 
+procedure TMessagesView.SetDblClickJumps(AValue: boolean);
+begin
+  if AValue then
+    MessagesFrame1.MessagesCtrl.Options:=
+      MessagesFrame1.MessagesCtrl.Options-[mcoSingleClickOpensFile]
+  else
+    MessagesFrame1.MessagesCtrl.Options:=
+      MessagesFrame1.MessagesCtrl.Options+[mcoSingleClickOpensFile]
+end;
+
+function TMessagesView.GetDblClickJumps: boolean;
+begin
+  Result:=not (mcoSingleClickOpensFile in MessagesFrame1.MessagesCtrl.Options);
 end;
 
 end.

ide/etquickfixes.pas

@@ -60,6 +60,7 @@ type
     procedure ClearLines;
     function AddMenuItem(Fix: TMsgQuickFix; Msg: TMessageLine; aCaption: string;
       aTag: PtrInt=0): TMenuItem; override;
+    function OpenMsg(Msg: TMessageLine): boolean;
     property ParentMenuItem: TMenuItem read FParentMenuItem write FParentMenuItem;
   end;
 
@@ -310,5 +311,17 @@ begin
   ParentMenuItem.Add(Result);
 end;
 
+function TIDEQuickFixes.OpenMsg(Msg: TMessageLine): boolean;
+var
+  i: Integer;
+begin
+  Result:=false;
+  if Msg=nil then exit;
+  for i:=0 to Count-1 do begin
+    Items[i].JumpTo(Msg,Result);
+    if Result then exit;
+  end;
+end;
+
 end.
 

ide/main.pp

@@ -4640,6 +4640,10 @@ begin
 
   if ObjectInspector1<>nil then
     TheEnvironmentOptions.ObjectInspectorOptions.Assign(ObjectInspector1);
+  {$IFDEF EnableNewExtTools}
+  if MessagesView<>nil then
+    TheEnvironmentOptions.MsgViewDblClickJumps:=MessagesView.DblClickJumps;
+  {$ENDIF}
 end;
 
 procedure TMainIDE.PackageTranslated(APackage: TLazPackage);
@@ -4653,6 +4657,10 @@ procedure TMainIDE.LoadDesktopSettings(TheEnvironmentOptions: TEnvironmentOption
 begin
   if ObjectInspector1<>nil then
     TheEnvironmentOptions.ObjectInspectorOptions.AssignTo(ObjectInspector1);
+  {$IFDEF EnableNewExtTools}
+  if MessagesView<>nil then
+    MessagesView.DblClickJumps:=TheEnvironmentOptions.MsgViewDblClickJumps;
+  {$ENDIF}
 end;
 
 procedure TMainIDE.OnLoadIDEOptions(Sender: TObject; AOptions: TAbstractIDEOptions);