diff --git a/ide/msgquickfixes.pas b/ide/msgquickfixes.pas index 63457a87ef..c7b22dea75 100644 --- a/ide/msgquickfixes.pas +++ b/ide/msgquickfixes.pas @@ -41,8 +41,8 @@ interface uses Classes, SysUtils, LCLProc, Controls, Dialogs, FileUtil, KeywordFuncLists, BasicCodeTools, CodeTree, CodeAtom, CodeCache, CodeToolManager, - IDEMsgIntf, TextTools, ProjectIntf, LazIDEIntf, - AbstractsMethodsDlg, LazarusIDEStrConsts; + DirectoryCacher, FileProcs, IDEMsgIntf, TextTools, ProjectIntf, LazIDEIntf, + PackageIntf, AbstractsMethodsDlg, LazarusIDEStrConsts, EnvironmentOpts; type @@ -117,6 +117,7 @@ procedure QuickFixUnitNotUsed(Sender: TObject; Step: TIMQuickFixStep; function GetMsgLineFile(Msg: TIDEMessageLine; out CodeBuf: TCodeBuffer; Quiet: boolean): boolean; +function IsFileInIDESrcDir(Filename: string): boolean; procedure InitStandardIDEQuickFixItems; procedure FreeStandardIDEQuickFixItems; @@ -234,6 +235,20 @@ begin Result:=true; end; +function IsFileInIDESrcDir(Filename: string): boolean; +var + LazDir: String; +begin + Filename:=TrimFilename(Filename); + if not FilenameIsAbsolute(Filename) then exit(false); + LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory); + Result:=FileIsInPath(Filename,LazDir+'ide') + or FileIsInPath(Filename,LazDir+'debugger') + or FileIsInPath(Filename,LazDir+'packager') + or FileIsInPath(Filename,LazDir+'converter') + or FileIsInPath(Filename,LazDir+'designer'); +end; + procedure InitStandardIDEQuickFixItems; begin IDEMsgQuickFixes:=TIDEMsgQuickFixItems.Create; @@ -278,61 +293,15 @@ procedure TQuickFixUnitNotFoundPosition.Execute(const Msg: TIDEMessageLine; // for example: // Fatal: Can't find unit Unit12 used by testunit1 // /home/user/laz/main.pp(1,1) Fatal: Can't find unit lazreport used by lazarus -var - CodeBuf: TCodeBuffer; - MissingUnitname: String; - NamePos, InPos: Integer; - UsedByUnit: String; - NewFilename: String; - Tool: TCodeTool; - Caret: TCodeXYPosition; - Dir: String; - PPUFilename: String; - s: String; -begin - if Step<>imqfoImproveMessage then exit; - //DebugLn('QuickFixUnitNotFoundPosition '); - if not REMatches(Msg.Msg,'Can''t find unit ([a-z_.0-9]+) used by ','I') then begin - DebugLn('QuickFixUnitNotFoundPosition invalid message ',Msg.Msg); - exit; - end; - MissingUnitname:=REVar(1); - CodeBuf:=nil; - Dir:=TrimFilename(Msg.Directory); - UsedByUnit:=''; - if REMatches(Msg.Msg,'Can''t find unit ([a-z_.0-9]+) used by ([a-z_.0-9]+)','I') - then begin - UsedByUnit:=REVar(2); - //debugln(['TQuickFixUnitNotFoundPosition.Execute Missing="',MissingUnitname,'" used by "',UsedByUnit,'"']); - if SysUtils.CompareText(UsedByUnit,MissingUnitname)<>0 then - begin - // the message belongs to another unit - NewFilename:=''; - if FilenameIsAbsolute(Dir) then - begin - // For example: /path/laz/main.pp(1,1) Fatal: Can't find unit lazreport used by lazarus - // => search source lazarus in directory - NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitInDirectory( - Dir,UsedByUnit,true); - end; - if NewFilename='' then begin - NewFilename:=LazarusIDE.FindUnitFile(UsedByUnit); - if NewFilename='' then begin - DebugLn('QuickFixUnitNotFoundPosition unit not found: ',UsedByUnit); - //ShowError('QuickFix: UnitNotFoundPosition unit not found: '+UsedByUnit); - end; - end; - if NewFilename<>'' then begin - CodeBuf:=CodeToolBoss.LoadFile(NewFilename,false,false); - if CodeBuf=nil then begin - DebugLn('QuickFixUnitNotFoundPosition unable to load unit: ',NewFilename); - //ShowError('QuickFix: UnitNotFoundPosition unable to load unit: '+NewFilename); - end; - end; - end; - end; - if CodeBuf<>nil then begin + procedure FixSourcePos(CodeBuf: TCodeBuffer; MissingUnitname: string; + var NewFilename: string; var Dir: string); + var + Caret: TCodeXYPosition; + Tool: TCodeTool; + InPos: Integer; + NamePos: Integer; + begin debugln(['TQuickFixUnitNotFoundPosition.Execute File=',CodeBuf.Filename]); LazarusIDE.SaveSourceEditorChangesToCodeCache(nil); if not CodeToolBoss.FindUnitInAllUsesSections(CodeBuf,MissingUnitname,NamePos,InPos) @@ -350,13 +319,114 @@ begin if (Msg.Directory<>'') and (FilenameIsAbsolute(Msg.Directory)) then NewFilename:=CreateRelativePath(NewFilename,Msg.Directory); Msg.SetSourcePosition(NewFilename,Caret.Y,Caret.X); - Dir:=TrimFilename(Msg.Directory); + Dir:=AppendPathDelim(TrimFilename(Msg.Directory)); end; end; +var + CodeBuf: TCodeBuffer; + MissingUnitname: String; + UsedByUnit: String; + NewFilename: String; + Dir: String; + PPUFilename: String; + s: String; + i: Integer; + Pkg: TIDEPackage; + UnitOutDir: String; + Filename: string; + Line: integer; + Col: integer; + DirCache: TCTDirectoryCache; +begin + if Step<>imqfoImproveMessage then exit; + //DebugLn('QuickFixUnitNotFoundPosition '); + + if not REMatches(Msg.Msg,'Can''t find unit ([a-z_.0-9]+) used by ','I') then begin + DebugLn('QuickFixUnitNotFoundPosition invalid message ',Msg.Msg); + exit; + end; + Dir:=AppendPathDelim(TrimFilename(Msg.Directory)); + if Dir='' then exit; + + Msg.GetSourcePosition(Filename,Line,Col); + MissingUnitname:=REVar(1); + UsedByUnit:=''; + if REMatches(Msg.Msg,'Can''t find unit ([a-z_.0-9]+) used by ([a-z_.0-9]+)','I') + then begin + UsedByUnit:=REVar(2); + //debugln(['TQuickFixUnitNotFoundPosition.Execute Missing="',MissingUnitname,'" used by "',UsedByUnit,'"']); + + if (CompareFilenames(ExtractFileName(Filename),'staticpackages.inc')=0) + and IsFileInIDESrcDir(Dir+'test') then begin + // common case: when building the IDE a package unit is missing + // staticpackages.inc(1,1) Fatal: Can't find unit sqldblaz used by Lazarus + // change to lazarus.pp(1,1) + NewFilename:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory)+'ide'+PathDelim; + Msg.SetSourcePosition(NewFilename,1,1); + Msg.Msg:='lazarus.pp(1,1) Fatal: Can''t find a valid '+MissingUnitname+'.ppu'; + Dir:=AppendPathDelim(TrimFilename(Msg.Directory)); + end else if SysUtils.CompareText(ExtractFileNameOnly(Filename),UsedByUnit)<>0 + then begin + // the message belongs to another unit + NewFilename:=''; + if FilenameIsAbsolute(Dir) then + begin + // For example: /path/laz/main.pp(1,1) Fatal: Can't find unit lazreport used by lazarus + // => search source lazarus in directory + NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitInDirectory( + Dir,UsedByUnit,true); + end; + if NewFilename='' then begin + NewFilename:=LazarusIDE.FindUnitFile(UsedByUnit); + if NewFilename='' then begin + DebugLn('QuickFixUnitNotFoundPosition unit not found: ',UsedByUnit); + //ShowError('QuickFix: UnitNotFoundPosition unit not found: '+UsedByUnit); + end; + end; + end; + end; + + // load source + CodeBuf:=nil; + if NewFilename<>'' then begin + CodeBuf:=CodeToolBoss.LoadFile(NewFilename,false,false); + if CodeBuf=nil then begin + DebugLn('QuickFixUnitNotFoundPosition unable to load unit: ',NewFilename); + //ShowError('QuickFix: UnitNotFoundPosition unable to load unit: '+NewFilename); + end; + end; + + // fix line and column + if CodeBuf<>nil then begin + FixSourcePos(CodeBuf,MissingUnitname,NewFilename,Dir); + end; + + // if the ppu is there then improve the message + //debugln(['TQuickFixUnitNotFoundPosition.Execute Dir=',Dir]); if FilenameIsAbsolute(Dir) then begin PPUFilename:=CodeToolBoss.DirectoryCachePool.FindCompiledUnitInCompletePath( Dir,MissingUnitname); + //debugln(['TQuickFixUnitNotFoundPosition.Execute AAA1 PPUFilename=',PPUFilename,' IsFileInIDESrcDir=',IsFileInIDESrcDir(Dir+'test')]); + if (PPUFilename='') and IsFileInIDESrcDir(Dir+'test') then begin + // search in installed packages + for i:=0 to PackageEditingInterface.GetPackageCount-1 do begin + Pkg:=PackageEditingInterface.GetPackages(i); + if Pkg.AutoInstall=pitNope then continue; + UnitOutDir:=Pkg.LazCompilerOptions.GetUnitOutputDirectory(false); + //debugln(['TQuickFixUnitNotFoundPosition.Execute ',Pkg.Name,' UnitOutDir=',UnitOutDir]); + if FilenameIsAbsolute(UnitOutDir) then begin + DirCache:=CodeToolBoss.DirectoryCachePool.GetCache(UnitOutDir,true,false); + PPUFilename:=DirCache.FindFile(MissingUnitname+'.ppu',ctsfcLoUpCase); + //debugln(['TQuickFixUnitNotFoundPosition.Execute ShortPPU=',PPUFilename]); + if PPUFilename<>'' then begin + PPUFilename:=AppendPathDelim(DirCache.Directory)+PPUFilename; + break; + end; + end; + end; + end; + if PPUFilename<>'' then begin // there is a ppu file, but the compiler didn't like it // => change message diff --git a/ideintf/packageintf.pas b/ideintf/packageintf.pas index ef1c1e49b7..ea8df76063 100644 --- a/ideintf/packageintf.pas +++ b/ideintf/packageintf.pas @@ -115,10 +115,17 @@ type property IDAsWord: string read FIDAsWord; end; + TPackageInstallType = ( + pitNope, + pitStatic, + pitDynamic + ); + { TIDEPackage } TIDEPackage = class(TLazPackageID) protected + FAutoInstall: TPackageInstallType; FCustomOptions: TConfigStorage; FFilename: string; FChangeStamp: integer; @@ -131,6 +138,7 @@ type procedure SetModified(const AValue: boolean); virtual; abstract; function GetRemovedCount: integer; virtual; abstract; function GetRemovedPkgFiles(Index: integer): TLazPackageFile; virtual; abstract; + procedure SetAutoInstall(AValue: TPackageInstallType); virtual; abstract; public procedure AssignOptions(Source: TPersistent); override; function IsVirtual: boolean; virtual; abstract; @@ -139,6 +147,8 @@ type destructor Destroy; override; procedure ClearCustomOptions; public + property AutoInstall: TPackageInstallType read FAutoInstall + write SetAutoInstall; property Filename: string read FFilename write SetFilename;//the .lpk filename property Modified: boolean read GetModified write SetModified; property DirectoryExpanded: string read GetDirectoryExpanded; diff --git a/packager/frames/package_integration_options.pas b/packager/frames/package_integration_options.pas index 9671bfedad..294229ff24 100644 --- a/packager/frames/package_integration_options.pas +++ b/packager/frames/package_integration_options.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Dialogs, - IDEOptionsIntf, MacroIntf, + IDEOptionsIntf, MacroIntf, PackageIntf, LazarusIDEStrConsts, PackageDefs, PathEditorDlg, IDEProcs, CodeHelp; type diff --git a/packager/openinstalledpkgdlg.pas b/packager/openinstalledpkgdlg.pas index c2c827eae2..e01da1b5d7 100644 --- a/packager/openinstalledpkgdlg.pas +++ b/packager/openinstalledpkgdlg.pas @@ -41,7 +41,7 @@ interface uses Classes, SysUtils, Forms, Controls, Buttons, ComCtrls, StdCtrls, FileCtrl, Dialogs, LCLProc, ExtCtrls, - IDEHelpIntf, IDEWindowIntf, + IDEHelpIntf, IDEWindowIntf, PackageIntf, PackageDefs, LazarusIDEStrConsts, PackageSystem; type diff --git a/packager/packagedefs.pas b/packager/packagedefs.pas index 71d4968d4f..111d46eb11 100644 --- a/packager/packagedefs.pas +++ b/packager/packagedefs.pas @@ -512,12 +512,6 @@ type ); TLazPackageFlags = set of TLazPackageFlag; - TPackageInstallType = ( - pitNope, - pitStatic, - pitDynamic - ); - TPackageUpdatePolicy = ( pupManually, pupOnRebuildingAll, @@ -564,7 +558,6 @@ type FAddToProjectUsesSection: boolean; FAuthor: string; FAutoCreated: boolean; - FAutoInstall: TPackageInstallType; FAutoUpdate: TPackageUpdatePolicy; FFPDocPackageName: string; FOptionsBackup: TLazPackage; @@ -621,7 +614,6 @@ type procedure SetAuthor(const AValue: string); procedure SetAutoCreated(const AValue: boolean); procedure SetAutoIncrementVersionOnBuild(const AValue: boolean); - procedure SetAutoInstall(const AValue: TPackageInstallType); procedure SetAutoUpdate(const AValue: TPackageUpdatePolicy); procedure SetDescription(const AValue: string); procedure SetEnableI18NForLFM(AValue: boolean); @@ -660,6 +652,7 @@ type procedure VersionChanged(Sender: TObject); override; function GetRemovedCount: integer; override; function GetRemovedPkgFiles(Index: integer): TLazPackageFile; override; + procedure SetAutoInstall(AValue: TPackageInstallType); override; public procedure AssignOptions(Source: TPersistent); override; constructor Create; @@ -783,8 +776,6 @@ type property AutoIncrementVersionOnBuild: boolean read GetAutoIncrementVersionOnBuild write SetAutoIncrementVersionOnBuild; - property AutoInstall: TPackageInstallType read FAutoInstall - write SetAutoInstall; property AutoUpdate: TPackageUpdatePolicy read FAutoUpdate write SetAutoUpdate; property CompilerOptions: TPkgCompilerOptions read FCompilerOptions; @@ -2359,7 +2350,7 @@ begin Modified:=true; end; -procedure TLazPackage.SetAutoInstall(const AValue: TPackageInstallType); +procedure TLazPackage.SetAutoInstall(AValue: TPackageInstallType); begin if FAutoInstall=AValue then exit; FAutoInstall:=AValue;