mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 12:09:57 +01:00
451 lines
13 KiB
ObjectPascal
451 lines
13 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 show information about the message
|
|
"recompiling unit1, checksum changed for unit2"
|
|
|
|
ToDo:
|
|
- show the location(s) of the first unit
|
|
- show the location(s) of the second unit
|
|
- actions:
|
|
- open a source file
|
|
- open a package
|
|
- delete a ppu+o file
|
|
- recompile a package clean (remove the .compiled file)
|
|
}
|
|
unit InspectChksumChangedDlg;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// RTL + FCL + LCL
|
|
Classes, SysUtils, contnrs,
|
|
LCLProc, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, ButtonPanel,
|
|
// CodeTools
|
|
CodeToolManager, FileProcs, DirectoryCacher, DefineTemplates,
|
|
// LazUtils
|
|
LazFileUtils, LazFileCache,
|
|
// IDEIntf
|
|
TextTools, IDEMsgIntf, PackageIntf, ProjectIntf, IDEExternToolIntf,
|
|
// IDE
|
|
LazarusIDEStrConsts;
|
|
|
|
const
|
|
ICC_FPC = '#FPC unit search path';
|
|
ICC_Project = '#Project';
|
|
type
|
|
TInspectChksumChgDialog = class;
|
|
|
|
{ TICCAction }
|
|
|
|
TICCAction = class
|
|
public
|
|
Dlg: TInspectChksumChgDialog;
|
|
Caption: string;
|
|
constructor Create(aDlg: TInspectChksumChgDialog; aCaption: string);
|
|
end;
|
|
|
|
{ TICCFile }
|
|
|
|
TICCFile = class(TComponent)
|
|
public
|
|
Filename: string;
|
|
Age: integer;
|
|
OwnerNames: TStringList;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TICCFiles }
|
|
|
|
TICCFiles = class(TComponentList)
|
|
private
|
|
function GetFiles(Index: integer): TICCFile;
|
|
procedure SetFiles(Index: integer; const AValue: TICCFile);
|
|
public
|
|
property Files[Index: integer]: TICCFile read GetFiles write SetFiles; default;
|
|
end;
|
|
|
|
{ TInspectChksumChgDialog }
|
|
|
|
TInspectChksumChgDialog = class(TForm)
|
|
ButtonPanel1: TButtonPanel;
|
|
InfoGroupBox: TGroupBox;
|
|
ProgressBar1: TProgressBar;
|
|
ActionsRadioGroup: TRadioGroup;
|
|
Splitter1: TSplitter;
|
|
InfoTreeView: TTreeView;
|
|
procedure CancelClick(Sender: TObject);
|
|
procedure OkClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
private
|
|
FMsg: string;
|
|
FUnit1: string;
|
|
FUnit1Files: TICCFiles;
|
|
FUnit2: string;
|
|
FUnit2Files: TICCFiles;
|
|
procedure FindUnitOwnerNames(aFile: TICCFile);
|
|
procedure SearchDirectory(anUnitName: string; Dir: string;
|
|
IsFPCPath: boolean; Files: TICCFiles);
|
|
procedure SearchInFPCFiles(anUnitName: string; Files: TICCFiles);
|
|
procedure SearchInSearchPath(anUnitName, SearchPath: string; Files: TICCFiles);
|
|
function SearchUnit(anUnitName, SearchPath: string): TICCFiles;
|
|
procedure AddNodesForUnit(anUnitName: string; Files: TICCFiles);
|
|
public
|
|
procedure InitWithMsg(const aMsg, aUnitName1, aUnitName2: string);
|
|
property Msg: string read FMsg;
|
|
property Unit1: string read FUnit1;
|
|
property Unit2: string read FUnit2;
|
|
property Unit1Files: TICCFiles read FUnit1Files;
|
|
property Unit2Files: TICCFiles read FUnit2Files;
|
|
end;
|
|
|
|
type
|
|
{ TQuickFixRecompilingChecksumChanged }
|
|
|
|
TQuickFixRecompilingChecksumChanged = class(TMsgQuickFix)
|
|
public
|
|
function IsApplicable(Msg: TMessageLine; out Unitname1, Unitname2: string): boolean;
|
|
procedure CreateMenuItems(Fixes: TMsgQuickFixes); override;
|
|
procedure QuickFix({%H-}Fixes: TMsgQuickFixes; Msg: TMessageLine); override;
|
|
end;
|
|
|
|
procedure InitInspectChecksumChangedQuickFixItems;
|
|
|
|
implementation
|
|
|
|
procedure InitInspectChecksumChangedQuickFixItems;
|
|
begin
|
|
RegisterIDEMsgQuickFix(TQuickFixRecompilingChecksumChanged.Create);
|
|
end;
|
|
|
|
{ TICCFile }
|
|
|
|
constructor TICCFile.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
OwnerNames:=TStringList.Create;
|
|
end;
|
|
|
|
destructor TICCFile.Destroy;
|
|
begin
|
|
FreeAndNil(OwnerNames);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TICCFiles }
|
|
|
|
function TICCFiles.GetFiles(Index: integer): TICCFile;
|
|
begin
|
|
Result:=TICCFile(Items[Index]);
|
|
end;
|
|
|
|
procedure TICCFiles.SetFiles(Index: integer; const AValue: TICCFile);
|
|
begin
|
|
Items[Index]:=AValue;
|
|
end;
|
|
|
|
{ TICCAction }
|
|
|
|
constructor TICCAction.Create(aDlg: TInspectChksumChgDialog; aCaption: string);
|
|
begin
|
|
Dlg:=aDlg;
|
|
Caption:=aCaption;
|
|
end;
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TInspectChksumChgDialog }
|
|
|
|
procedure TInspectChksumChgDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption:='Inspect checksum changed message';
|
|
InfoGroupBox.Caption:='Hints:';
|
|
ActionsRadioGroup.Caption:='Actions';
|
|
|
|
ButtonPanel1.OKButton.OnClick:=@OkClick;
|
|
ButtonPanel1.CancelButton.OnClick:=@CancelClick;
|
|
ProgressBar1.Visible:=false;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.OkClick(Sender: TObject);
|
|
begin
|
|
ModalResult:=mrOK;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.CancelClick(Sender: TObject);
|
|
begin
|
|
ModalResult:=mrCancel;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.FormDestroy(Sender: TObject);
|
|
begin
|
|
FreeAndNil(FUnit1Files);
|
|
FreeAndNil(FUnit2Files);
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.FindUnitOwnerNames(aFile: TICCFile);
|
|
var
|
|
Owners: TFPList;
|
|
i: Integer;
|
|
begin
|
|
Owners:=PackageEditingInterface.GetPossibleOwnersOfUnit(aFile.Filename,
|
|
[piosfIncludeSourceDirectories]);
|
|
//debugln(['TInspectChksumChgDialog.FindUnitOwnerNames ',aFile.Filename,' ',DbgSName(Owners)]);
|
|
if Owners<>nil then begin
|
|
for i:=0 to Owners.Count-1 do begin
|
|
if TObject(Owners[i]) is TIDEPackage then
|
|
aFile.OwnerNames.Add(TIDEPackage(Owners[i]).Name)
|
|
else if TObject(Owners[i]) is TLazProject then
|
|
aFile.OwnerNames.Add(ICC_Project);
|
|
end;
|
|
Owners.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.SearchDirectory(anUnitName: string;
|
|
Dir: string; IsFPCPath: boolean; Files: TICCFiles);
|
|
var
|
|
DirCache: TCTDirectoryCache;
|
|
i: Integer;
|
|
Filename: PChar;
|
|
Ext: String;
|
|
aFile: TICCFile;
|
|
j: Integer;
|
|
begin
|
|
if (Dir='') or (not FilenameIsAbsolute(Dir)) then exit;
|
|
// search in directory for all files that could be sources or ppu files of this unit
|
|
DirCache:=CodeToolBoss.DirectoryCachePool.GetCache(Dir,true,false);
|
|
if (DirCache=nil) or (DirCache.Listing=nil) then exit;
|
|
for i:=0 to DirCache.Listing.Count-1 do begin
|
|
Filename:=DirCache.Listing.GetFilename(i);
|
|
Ext:=lowercase(ExtractFileExt(Filename));
|
|
if ((Ext='.pas') or (Ext='.pp') or (Ext='.p') or (Ext='.ppu'))
|
|
and (SysUtils.CompareText(anUnitName,ExtractFileNameOnly(Filename))=0)
|
|
then begin
|
|
j:=Files.Count-1;
|
|
while (j>=0) and (CompareFilenames(Files[j].Filename,Filename)<>0) do
|
|
dec(j);
|
|
if j<0 then begin
|
|
//debugln(['TInspectChksumChgDialog.SearchUnit Unit="',anUnitName,'" Filename="',Filename,'"']);
|
|
aFile:=TICCFile.Create(nil);
|
|
aFile.Filename:=AppendPathDelim(Dir)+Filename;
|
|
aFile.Age:=FileAgeCached(aFile.Filename);
|
|
FindUnitOwnerNames(aFile);
|
|
if IsFPCPath then
|
|
aFile.OwnerNames.Add(ICC_FPC);
|
|
Files.Add(aFile);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.SearchInSearchPath(anUnitName,
|
|
SearchPath: string; Files: TICCFiles);
|
|
var
|
|
CurDir: String;
|
|
p: LongInt;
|
|
l: Integer;
|
|
StartPos: Integer;
|
|
begin
|
|
// search in search path
|
|
StartPos:=1;
|
|
l:=length(SearchPath);
|
|
while StartPos<=l do begin
|
|
p:=StartPos;
|
|
while (p<=l) and (SearchPath[p]<>';') do inc(p);
|
|
CurDir:=TrimFilename(copy(SearchPath,StartPos,p-StartPos));
|
|
SearchDirectory(anUnitName,CurDir,false,Files);
|
|
StartPos:=p+1;
|
|
end;
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.SearchInFPCFiles(
|
|
anUnitName: string; Files: TICCFiles);
|
|
var
|
|
UnitSetID: String;
|
|
UnitSet: TFPCUnitSetCache;
|
|
CfgCache: TFPCTargetConfigCache;
|
|
i: Integer;
|
|
HasChanged: boolean;
|
|
CurDir: String;
|
|
begin
|
|
// search in fpc unit paths
|
|
UnitSetID:=CodeToolBoss.GetUnitSetIDForDirectory('');
|
|
if UnitSetID='' then exit;
|
|
UnitSet:=CodeToolBoss.FPCDefinesCache.FindUnitSetWithID(UnitSetID,HasChanged,false);
|
|
if UnitSet=nil then exit;
|
|
CfgCache:=UnitSet.GetConfigCache(false);
|
|
if CfgCache=nil then exit;
|
|
if CfgCache.UnitPaths=nil then exit;
|
|
for i:=0 to CfgCache.UnitPaths.Count-1 do begin
|
|
CurDir:=TrimFilename(CfgCache.UnitPaths[i]);
|
|
SearchDirectory(anUnitName,CurDir,false,Files);
|
|
end;
|
|
end;
|
|
|
|
function TInspectChksumChgDialog.SearchUnit(anUnitName, SearchPath: string
|
|
): TICCFiles;
|
|
begin
|
|
Result:=TICCFiles.create(true);
|
|
if (anUnitName='') then exit;
|
|
|
|
SearchInSearchPath(anUnitName,SearchPath,Result);
|
|
SearchInFPCFiles(anUnitName,Result);
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.AddNodesForUnit(anUnitName: string;
|
|
Files: TICCFiles);
|
|
var
|
|
UnitNode: TTreeNode;
|
|
i: Integer;
|
|
aFile: TICCFile;
|
|
FileNode: TTreeNode;
|
|
OwnerName: string;
|
|
j: Integer;
|
|
s: String;
|
|
APackage: TIDEPackage;
|
|
PPUCount: Integer;
|
|
SrcCount: Integer;
|
|
begin
|
|
UnitNode:=InfoTreeView.Items.Add(nil,'Unit '+anUnitName);
|
|
if Files<>nil then begin
|
|
PPUCount:=0;
|
|
SrcCount:=0;
|
|
for i:=0 to Files.Count-1 do begin
|
|
aFile:=Files[i];
|
|
if CompareFileExt(aFile.Filename,'.ppu',false)=0 then
|
|
inc(PPUCount)
|
|
else
|
|
inc(SrcCount);
|
|
FileNode:=InfoTreeView.Items.AddChildObject(UnitNode,aFile.Filename,aFile);
|
|
for j:=0 to aFile.OwnerNames.Count-1 do begin
|
|
OwnerName:=aFile.OwnerNames[j];
|
|
if OwnerName=ICC_FPC then begin
|
|
s:=lisInFPCUnitSearchPathProbablyInstalledByTheFPCPackag;
|
|
end else if OwnerName=ICC_Project then begin
|
|
s:=lisInASourceDirectoryOfTheProjectCheckForDuplicates;
|
|
end else begin
|
|
s:=Format(lisInASourceDirectoryOfThePackage, [OwnerName]);
|
|
APackage:=PackageEditingInterface.FindPackageWithName(OwnerName);
|
|
if APackage<>nil then begin
|
|
if APackage.IsVirtual then begin
|
|
s:=Format(lisCheckTheTargetOSCPULCLWidgetTypeMaybeYouHaveToReco, [s]);
|
|
end else begin
|
|
s:=Format(lisMaybeYouHaveToRecompileThePackage, [s]);
|
|
end;
|
|
end;
|
|
end;
|
|
if s<>'' then
|
|
InfoTreeView.Items.AddChild(FileNode,s);
|
|
end;
|
|
end;
|
|
if PPUCount>1 then begin
|
|
// ToDo: Fix uninitialized FileNode. It is initialized inside a loop, this is outside of the loop.
|
|
InfoTreeView.Items.AddChild(FileNode,
|
|
lisDuplicatePpuFilesDeleteOneOrMakeSureAllSearchPaths);
|
|
end;
|
|
if SrcCount>1 then begin
|
|
InfoTreeView.Items.AddChild(FileNode,
|
|
lisDuplicateSourcesDeleteOneOrMakeSureAllSearchPathsH);
|
|
end;
|
|
end;
|
|
UnitNode.Expand(true);
|
|
end;
|
|
|
|
procedure TInspectChksumChgDialog.InitWithMsg(const aMsg, aUnitName1,
|
|
aUnitName2: string);
|
|
var
|
|
SearchPath: String;
|
|
begin
|
|
FMsg:=aMsg;
|
|
FUnit1:=aUnitName1;
|
|
FUnit2:=aUnitName2;
|
|
FreeAndNil(FUnit1Files);
|
|
FreeAndNil(FUnit2Files);
|
|
|
|
SearchPath:=CodeToolBoss.GetCompleteSrcPathForDirectory('');
|
|
//debugln(['TInspectChksumChgDialog.InitWithMsg SearchPath=',SearchPath]);
|
|
FUnit1Files:=SearchUnit(Unit1,SearchPath);
|
|
FUnit2Files:=SearchUnit(Unit2,SearchPath);
|
|
|
|
InfoTreeView.BeginUpdate;
|
|
InfoTreeView.Items.Clear;
|
|
|
|
InfoTreeView.Items.Add(nil,'Message: '+dbgstr(Msg));
|
|
|
|
AddNodesForUnit(Unit1,Unit1Files);
|
|
AddNodesForUnit(Unit2,Unit2Files);
|
|
|
|
InfoTreeView.EndUpdate;
|
|
end;
|
|
|
|
{ TQuickFixRecompilingChecksumChanged }
|
|
|
|
function TQuickFixRecompilingChecksumChanged.IsApplicable(Msg: TMessageLine;
|
|
out Unitname1, Unitname2: string): boolean;
|
|
begin
|
|
// check: Recompiling $1, checksum changed for $2
|
|
Result:=IDEFPCParser.MsgLineIsId(Msg,10028,Unitname1,Unitname2);
|
|
end;
|
|
|
|
procedure TQuickFixRecompilingChecksumChanged.CreateMenuItems(
|
|
Fixes: TMsgQuickFixes);
|
|
var
|
|
Msg: TMessageLine;
|
|
Unitname1: string;
|
|
Unitname2: string;
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to Fixes.LineCount-1 do begin
|
|
Msg:=Fixes.Lines[i];
|
|
if not IsApplicable(Msg,Unitname1,Unitname2) then continue;
|
|
Fixes.AddMenuItem(Self,Msg,'Explore message "checksum changed"');
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TQuickFixRecompilingChecksumChanged.QuickFix(Fixes: TMsgQuickFixes;
|
|
Msg: TMessageLine);
|
|
var
|
|
Unit1: String;
|
|
Unit2: String;
|
|
Dlg: TInspectChksumChgDialog;
|
|
begin
|
|
if not IsApplicable(Msg,Unit1,Unit2) then exit;
|
|
debugln(['TQuickFixRecompilingChecksumChanged.Execute Unit1=',REVar(1),', checksum changed for Unit2=',REVar(2)]);
|
|
Dlg:=TInspectChksumChgDialog.Create(nil);
|
|
try
|
|
Dlg.InitWithMsg(Msg.Msg,Unit1,Unit2);
|
|
Dlg.ShowModal;
|
|
finally
|
|
Dlg.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|