mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-08 12:50:03 +01:00
IDE: further migration external tools
git-svn-id: trunk@42326 -
This commit is contained in:
parent
d8f969f59c
commit
b2500fb625
@ -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);
|
||||
|
||||
@ -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}
|
||||
@ -371,6 +373,18 @@ type
|
||||
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.
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user