mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-30 09:43:39 +02:00
402 lines
12 KiB
ObjectPascal
402 lines
12 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
Dialog to search a missing unit.
|
|
}
|
|
unit FindUnitDlg;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, LResources, ExtCtrls,
|
|
StdCtrls, ComCtrls, FileUtil, AvgLvlTree,
|
|
// codetools
|
|
CodeCache, CodeToolManager,
|
|
// IDEIntf
|
|
LazIDEIntf, TextTools, IDEMsgIntf, PackageIntf,
|
|
// IDE
|
|
PackageDefs, Project, IDEProcs, LazarusIDEStrConsts, MsgQuickFixes,
|
|
PackageSystem, BasePkgManager;
|
|
|
|
type
|
|
|
|
{ TQuickFixMissingUnit }
|
|
|
|
TQuickFixMissingUnit = class
|
|
public
|
|
Caption: string;
|
|
constructor Create(aCaption: string);
|
|
end;
|
|
|
|
{ TQuickFixMissingUnitAddRequirement }
|
|
|
|
TQuickFixMissingUnitAddRequirement = class(TQuickFixMissingUnit)
|
|
public
|
|
PackageName: string;
|
|
constructor Create(aPackageName: string);
|
|
end;
|
|
|
|
{ TFindUnitDialog }
|
|
|
|
TFindUnitDialog = class(TForm)
|
|
OkButton: TButton;
|
|
CancelButton: TButton;
|
|
BtnPanel: TPanel;
|
|
InfoGroupBox: TGroupBox;
|
|
QuickFixRadioGroup: TRadioGroup;
|
|
Splitter1: TSplitter;
|
|
InfoTreeView: TTreeView;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure OkButtonClick(Sender: TObject);
|
|
procedure OnIdle(Sender: TObject; var Done: Boolean);
|
|
private
|
|
FCode: TCodeBuffer;
|
|
FMainOwner: TObject;
|
|
FMissingUnitName: string;
|
|
FSearchPackages: TStrings;
|
|
FSearchPackagesIndex: integer;
|
|
fQuickFixes: TFPList;// list of TQuickFixMissingUnit
|
|
procedure InitSearchPackages;
|
|
procedure AddQuickFix(Item: TQuickFixMissingUnit);
|
|
procedure AddRequirement(Item: TQuickFixMissingUnitAddRequirement);
|
|
public
|
|
procedure InitWithMsg(Msg: TIDEMessageLine; Line: string; aCode: TCodeBuffer;
|
|
aMissingUnitName: string);
|
|
property Code: TCodeBuffer read FCode;
|
|
property MissingUnitName: string read FMissingUnitName;
|
|
property MainOwner: TObject read FMainOwner;
|
|
end;
|
|
|
|
{ TQuickFixUnitNotFound_Search }
|
|
|
|
TQuickFixUnitNotFound_Search = class(TIDEMsgQuickFixItem)
|
|
public
|
|
constructor Create;
|
|
function IsApplicable(Line: TIDEMessageLine): boolean; override;
|
|
procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
|
|
end;
|
|
|
|
procedure InitFindUnitQuickFixItems;
|
|
|
|
implementation
|
|
|
|
procedure InitFindUnitQuickFixItems;
|
|
begin
|
|
RegisterIDEMsgQuickFix(TQuickFixUnitNotFound_Search.Create);
|
|
end;
|
|
|
|
{ TQuickFixUnitNotFound_Search }
|
|
|
|
constructor TQuickFixUnitNotFound_Search.Create;
|
|
begin
|
|
Name:='Search unit: Error: Can''t find unit Name';
|
|
Caption:='Search unit';
|
|
Steps:=[imqfoMenuItem];
|
|
end;
|
|
|
|
function TQuickFixUnitNotFound_Search.IsApplicable(Line: TIDEMessageLine
|
|
): boolean;
|
|
const
|
|
SearchStr = ') Fatal: Can''t find unit ';
|
|
var
|
|
Msg: String;
|
|
p: integer;
|
|
Code: TCodeBuffer;
|
|
Filename: string;
|
|
Caret: TPoint;
|
|
begin
|
|
Result:=false;
|
|
if (Line.Parts=nil) then exit;
|
|
Msg:=Line.Msg;
|
|
p:=System.Pos(SearchStr,Msg);
|
|
if p<1 then exit;
|
|
inc(p,length(SearchStr));
|
|
Line.GetSourcePosition(Filename,Caret.Y,Caret.X);
|
|
if (Filename='') or (Caret.X<1) or (Caret.Y<1) then exit;
|
|
if not FilenameIsAbsolute(Filename) then
|
|
Filename:=Line.Directory+Filename;
|
|
Code:=CodeToolBoss.LoadFile(Filename,true,false);
|
|
if Code=nil then exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TQuickFixUnitNotFound_Search.Execute(const Msg: TIDEMessageLine;
|
|
Step: TIMQuickFixStep);
|
|
var
|
|
AnUnitName: String;
|
|
Dlg: TFindUnitDialog;
|
|
CodeBuf: TCodeBuffer;
|
|
Filename: string;
|
|
Caret: TPoint;
|
|
begin
|
|
if Step=imqfoMenuItem then begin
|
|
DebugLn(['TQuickFixUnitNotFound_Search.Execute ']);
|
|
// get source position
|
|
// (FPC reports position right after the unknown identifier
|
|
// for example right after FilenameIsAbsolute)
|
|
if not GetMsgLineFilename(Msg,CodeBuf) then exit;
|
|
Msg.GetSourcePosition(Filename,Caret.Y,Caret.X);
|
|
if not LazarusIDE.BeginCodeTools then begin
|
|
DebugLn(['TQuickFixUnitNotFound_Search.Execute failed because IDE busy']);
|
|
exit;
|
|
end;
|
|
|
|
// get unitname
|
|
if not REMatches(Msg.Msg,'Fatal: Can''t find unit ([a-z_0-9]+) ','I') then begin
|
|
DebugLn('TQuickFixUnitNotFound_Search invalid message ',Msg.Msg);
|
|
exit;
|
|
end;
|
|
AnUnitName:=REVar(1);
|
|
DebugLn(['TQuickFixUnitNotFound_Search.Execute Unit=',AnUnitName]);
|
|
|
|
if (AnUnitName='') or (not IsValidIdent(AnUnitName)) then begin
|
|
DebugLn(['TQuickFixUnitNotFound_Search.Execute not an identifier "',dbgstr(AnUnitName),'"']);
|
|
exit;
|
|
end;
|
|
|
|
// show dialog
|
|
Dlg:=TFindUnitDialog.Create(nil);
|
|
try
|
|
Dlg.InitWithMsg(Msg,Msg.Msg,CodeBuf,AnUnitName);
|
|
Dlg.ShowModal;
|
|
finally
|
|
Dlg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TFindUnitDialog }
|
|
|
|
procedure TFindUnitDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
fQuickFixes:=TFPList.Create;
|
|
|
|
Caption:=lisFindMissingUnit;
|
|
CancelButton.Caption:=dlgCancel;
|
|
OkButton.Caption:=dlgMouseOptBtnOk;
|
|
OkButton.Enabled:=false;
|
|
InfoGroupBox.Caption:=lisInformation;
|
|
QuickFixRadioGroup.Caption:=lisQuickFixes;
|
|
|
|
Application.AddOnIdleHandler(@OnIdle);
|
|
end;
|
|
|
|
procedure TFindUnitDialog.FormDestroy(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Application.RemoveOnIdleHandler(@OnIdle);
|
|
for i:=0 to fQuickFixes.Count-1 do TObject(fQuickFixes[i]).Free;
|
|
FreeAndNil(fQuickFixes);
|
|
FreeAndNil(FSearchPackages);
|
|
end;
|
|
|
|
procedure TFindUnitDialog.OkButtonClick(Sender: TObject);
|
|
var
|
|
i: LongInt;
|
|
Item: TQuickFixMissingUnit;
|
|
begin
|
|
i:=QuickFixRadioGroup.ItemIndex;
|
|
if i<0 then begin
|
|
OkButton.Enabled:=false;
|
|
exit;
|
|
end;
|
|
Item:=TQuickFixMissingUnit(fQuickFixes[i]);
|
|
if Item is TQuickFixMissingUnitAddRequirement then
|
|
AddRequirement(TQuickFixMissingUnitAddRequirement(Item));
|
|
end;
|
|
|
|
procedure TFindUnitDialog.OnIdle(Sender: TObject; var Done: Boolean);
|
|
var
|
|
Filename: string;
|
|
i: Integer;
|
|
APackage: TLazPackage;
|
|
begin
|
|
if (FSearchPackages<>nil) and (FSearchPackagesIndex<FSearchPackages.Count)
|
|
then begin
|
|
Filename:=FSearchPackages[FSearchPackagesIndex];
|
|
for i:=0 to PackageGraph.Count-1 do begin
|
|
APackage:=PackageGraph.Packages[i];
|
|
if APackage.Filename=Filename then begin
|
|
if APackage.FindUnit(MissingUnitName)<>nil then
|
|
AddQuickFix(TQuickFixMissingUnitAddRequirement.Create(APackage.Name));
|
|
end;
|
|
end;
|
|
inc(FSearchPackagesIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TFindUnitDialog.InitSearchPackages;
|
|
var
|
|
i: Integer;
|
|
APackage: TLazPackage;
|
|
Filename: String;
|
|
begin
|
|
if FSearchPackages=nil then
|
|
FSearchPackages:=TStringList.Create;
|
|
FSearchPackages.Clear;
|
|
FSearchPackagesIndex:=0;
|
|
if FMainOwner=nil then exit;
|
|
for i:=0 to PackageGraph.Count-1 do begin
|
|
APackage:=PackageGraph.Packages[i];
|
|
Filename:=APackage.GetResolvedFilename(true);
|
|
//DebugLn(['TFindUnitDialog.InitSearchPackages ',APackage.Name,' ',Filename]);
|
|
if (Filename='') or (not FileExistsCached(Filename)) then continue;
|
|
FSearchPackages.Add(APackage.Filename);
|
|
end;
|
|
//DebugLn(['TFindUnitDialog.InitSearchPackages ',FSearchPackages.Text]);
|
|
|
|
end;
|
|
|
|
procedure TFindUnitDialog.AddQuickFix(Item: TQuickFixMissingUnit);
|
|
begin
|
|
fQuickFixes.Add(Item);
|
|
QuickFixRadioGroup.Items.Add(Item.Caption);
|
|
if QuickFixRadioGroup.ItemIndex<0 then
|
|
QuickFixRadioGroup.ItemIndex:=0;
|
|
OkButton.Enabled:=true;
|
|
end;
|
|
|
|
procedure TFindUnitDialog.AddRequirement(
|
|
Item: TQuickFixMissingUnitAddRequirement);
|
|
var
|
|
AProject: TProject;
|
|
APackage: TLazPackage;
|
|
begin
|
|
if FMainOwner is TProject then begin
|
|
AProject:=TProject(FMainOwner);
|
|
if PkgBoss.AddProjectDependencies(AProject,Item.PackageName)=mrOk then
|
|
ModalResult:=mrOK;
|
|
end else if FMainOwner is TLazPackage then begin
|
|
APackage:=TLazPackage(FMainOwner);
|
|
if PkgBoss.AddPackageDependency(APackage,Item.PackageName)=mrOk then
|
|
ModalResult:=mrOK;
|
|
end;
|
|
end;
|
|
|
|
procedure TFindUnitDialog.InitWithMsg(Msg: TIDEMessageLine; Line: string;
|
|
aCode: TCodeBuffer; aMissingUnitName: string);
|
|
|
|
procedure AddPaths(ParentTVNode: TTreeNode; PathTitle, BaseDir, Paths: string;
|
|
Expanded: boolean);
|
|
var
|
|
p: Integer;
|
|
s: String;
|
|
PathsNode: TTreeNode;
|
|
begin
|
|
PathsNode:=InfoTreeView.Items.AddChild(ParentTVNode,PathTitle);
|
|
Paths:=CreateAbsoluteSearchPath(Paths,BaseDir);
|
|
p:=1;
|
|
repeat
|
|
s:=GetNextDirectoryInSearchPath(Paths,p);
|
|
if s<>'' then
|
|
InfoTreeView.Items.AddChild(PathsNode,dbgstr(s));
|
|
until p>length(Paths);
|
|
PathsNode.Expanded:=Expanded;
|
|
if (ParentTVNode<>nil) and Expanded then
|
|
ParentTVNode.Expanded:=true;
|
|
end;
|
|
|
|
var
|
|
UnitPath: String;
|
|
Directory: String;
|
|
DirNode: TTreeNode;
|
|
Owners: TFPList;
|
|
i: Integer;
|
|
OwnerNode: TTreeNode;
|
|
AProject: TProject;
|
|
APackage: TLazPackage;
|
|
begin
|
|
FCode:=aCode;
|
|
FMissingUnitName:=aMissingUnitName;
|
|
FMainOwner:=nil;
|
|
|
|
InfoTreeView.BeginUpdate;
|
|
InfoTreeView.Items.Clear;
|
|
|
|
Owners:=nil;
|
|
try
|
|
InfoTreeView.Items.Add(nil,'Message: '+dbgstr(Line));
|
|
InfoTreeView.Items.Add(nil,'File: '+dbgstr(aCode.Filename));
|
|
InfoTreeView.Items.Add(nil,'Missingg unit: '+dbgstr(aMissingUnitName));
|
|
Directory:=ExtractFilePath(aCode.Filename);
|
|
DirNode:=InfoTreeView.Items.Add(nil,'Directory: '+dbgstr(Directory));
|
|
|
|
// unit path of directory
|
|
UnitPath:=CodeToolBoss.GetUnitPathForDirectory(Directory);
|
|
AddPaths(DirNode,'IDE unit search path:',Directory,UnitPath,false);
|
|
|
|
//
|
|
Owners:=PackageEditingInterface.GetOwnersOfUnit(aCode.Filename);
|
|
if Owners<>nil then begin
|
|
for i:=0 to Owners.Count-1 do begin
|
|
if TObject(Owners[i]) is TProject then begin
|
|
AProject:=TProject(Owners[i]);
|
|
if FMainOwner=nil then FMainOwner:=AProject;
|
|
OwnerNode:=InfoTreeView.Items.Add(nil,'Owner: Project');
|
|
AddPaths(OwnerNode,'Unit search paths',AProject.ProjectDirectory,
|
|
AProject.CompilerOptions.GetUnitPath(true),true);
|
|
|
|
end
|
|
else if TObject(Owners[i]) is TLazPackage then begin
|
|
APackage:=TLazPackage(Owners[i]);
|
|
if FMainOwner=nil then FMainOwner:=APackage;
|
|
OwnerNode:=InfoTreeView.Items.Add(nil,'Owner: Package '+APackage.IDAsString);
|
|
AddPaths(OwnerNode,'Unit search paths',APackage.Directory,
|
|
APackage.CompilerOptions.GetUnitPath(true),true);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Owners.Free;
|
|
end;
|
|
|
|
InfoTreeView.EndUpdate;
|
|
|
|
InitSearchPackages;
|
|
end;
|
|
|
|
{ TQuickFixMissingUnit }
|
|
|
|
constructor TQuickFixMissingUnit.Create(aCaption: string);
|
|
begin
|
|
Caption:=aCaption;
|
|
end;
|
|
|
|
{ TQuickFixMissingUnitAddRequirement }
|
|
|
|
constructor TQuickFixMissingUnitAddRequirement.Create(aPackageName: string);
|
|
begin
|
|
PackageName:=aPackageName;
|
|
Caption:='Add package '+PackageName+' as requirement';
|
|
end;
|
|
|
|
initialization
|
|
{$I findunitdlg.lrs}
|
|
|
|
end.
|
|
|