From 4acd20bf61018d1a3614a5705b607b5967d8c8d0 Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 16 Apr 2003 22:11:35 +0000 Subject: [PATCH] fixed codetools Makefile, fixed default prop not found error git-svn-id: trunk@4066 - --- components/codetools/Makefile | 1 + components/codetools/Makefile.fpc | 1 + components/codetools/finddeclarationtool.pas | 5 +- components/synedit/Makefile.fpc | 2 +- ide/mainbar.pas | 2 + lcl/forms.pp | 3 +- lcl/include/customform.inc | 5 +- lcl/include/screen.inc | 30 +++--- packager/basepkgmanager.pas | 2 + packager/packagedefs.pas | 11 +- packager/packagesystem.pas | 54 +++++++++- packager/pkgmanager.pas | 104 ++++++++++++++++++- 12 files changed, 194 insertions(+), 26 deletions(-) diff --git a/components/codetools/Makefile b/components/codetools/Makefile index 79ad258c83..563d56d17e 100644 --- a/components/codetools/Makefile +++ b/components/codetools/Makefile @@ -217,6 +217,7 @@ override TARGET_UNITS+=allcodetoolunits override TARGET_IMPLICITUNITS+=codetoolsstrconsts avl_tree basiccodetools codecache sourcelog customcodetool multikeywordlisttool pascalparsertool finddeclarationtool identcompletiontool stdcodetools resourcecodetool methodjumptool eventcodetool codecompletiontool codeatom codetree definetemplates expreval keywordfunclists linkscanner sourcechanger fileprocs codetoolsstructs codetoolmanager memcheck override CLEAN_FILES+=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) override COMPILER_OPTIONS+=-gl +override COMPILER_UNITDIR+=. override COMPILER_UNITTARGETDIR+=../units ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) diff --git a/components/codetools/Makefile.fpc b/components/codetools/Makefile.fpc index ca4da3cc97..72a51ff93f 100644 --- a/components/codetools/Makefile.fpc +++ b/components/codetools/Makefile.fpc @@ -12,6 +12,7 @@ packages=fcl [compiler] unittargetdir=../units +unitdir=. options=-gl [target] diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index b5d70ca096..7c6f3dbb74 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -1666,8 +1666,9 @@ var if (Identifier='') and (Params.Identifier<>nil) and (Params.Identifier[0]<>#0) then begin Identifier:=Params.Identifier[0]; - if Identifier='[' then + if Identifier='[' then begin Params.IdentifierTool.RaiseException(ctsDefaultPropertyNotFound); + end; end; Params.IdentifierTool.RaiseExceptionFmt(ctsIdentifierNotFound, [Identifier]); @@ -3914,7 +3915,7 @@ var Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound] +fdfGlobals*Params.Flags; // special identifier for default property - Params.SetIdentifier(ExprType.Context.Tool,@Src[CurAtom.StartPos],nil); + Params.SetIdentifier(Self,@Src[CurAtom.StartPos],nil); Params.ContextNode:=ExprType.Context.Node; ExprType.Context.Tool.FindIdentifierInContext(Params); ExprType.Context:=CreateFindContext(Params); diff --git a/components/synedit/Makefile.fpc b/components/synedit/Makefile.fpc index e702435774..4180b7a357 100644 --- a/components/synedit/Makefile.fpc +++ b/components/synedit/Makefile.fpc @@ -9,7 +9,7 @@ version=0.8a [compiler] unittargetdir=../units -unitdir=../../lcl/units +unitdir=../../lcl/units . options=-gl [target] diff --git a/ide/mainbar.pas b/ide/mainbar.pas index 9c42058de1..154d2c96ee 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -359,6 +359,8 @@ type function DoCheckCreatingFile(const AFilename: string; CheckReadable: boolean): TModalResult; virtual; + function DoSaveForBuild: TModalResult; virtual; abstract; + function DoCheckFilesOnDisk: TModalResult; virtual; abstract; function DoCheckAmbigiousSources(const AFilename: string; Compiling: boolean): TModalResult; diff --git a/lcl/forms.pp b/lcl/forms.pp index 3dba612fa3..f300563756 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -525,7 +525,8 @@ type function CustomFormIndex(AForm: TCustomForm): integer; function FormIndex(AForm: TForm): integer; function CustomFormZIndex(AForm: TCustomForm): integer; - procedure MoveFormToFront(ACustomForm: TCustomForm); + procedure MoveFormToFocusFront(ACustomForm: TCustomForm); + procedure MoveFormToZFront(ACustomForm: TCustomForm); public property ActiveControl: TWinControl read FActiveControl; property ActiveCustomForm: TCustomForm read FActiveCustomForm; diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 92a0d4aa74..5a033756c1 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -1133,7 +1133,7 @@ begin // update Screen object Screen.FActiveControl := Control; Screen.FActiveCustomForm := Self; - Screen.MoveFormToFront(Self); + Screen.MoveFormToFocusFront(Self); if Self is TForm then Screen.FActiveForm := TForm(Self) else @@ -1406,6 +1406,9 @@ end; { ============================================================================= $Log$ + Revision 1.96 2003/04/16 22:11:35 mattias + fixed codetools Makefile, fixed default prop not found error + Revision 1.95 2003/04/16 17:20:24 mattias implemented package check broken dependency on compile diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index e2cfcfdce5..3e285fbcba 100644 --- a/lcl/include/screen.inc +++ b/lcl/include/screen.inc @@ -88,6 +88,23 @@ begin while (Result>=0) and (CustomFormsZOrdered[Result]<>AForm) do dec(Result); end; +procedure TScreen.MoveFormToFocusFront(ACustomForm: TCustomForm); +begin + FCustomForms.Remove(ACustomForm); + FCustomForms.Insert(0, ACustomForm); + if ACustomForm is TForm then + begin + Screen.FFormList.Remove(ACustomForm); + Screen.FFormList.Insert(0, ACustomForm); + end; +end; + +procedure TScreen.MoveFormToZFront(ACustomForm: TCustomForm); +begin + FCustomFormsZOrdered.Remove(ACustomForm); + FCustomFormsZOrdered.Insert(0, ACustomForm); +end; + {------------------------------------------------------------------------------ function TScreen.GetFonts : TStrings; ------------------------------------------------------------------------------} @@ -339,18 +356,5 @@ begin end; end; -procedure TScreen.MoveFormToFront(ACustomForm: TCustomForm); -begin - FCustomForms.Remove(ACustomForm); - FCustomForms.Insert(0, ACustomForm); - FCustomFormsZOrdered.Remove(ACustomForm); - FCustomFormsZOrdered.Insert(0, ACustomForm); - if ACustomForm is TForm then - begin - Screen.FFormList.Remove(ACustomForm); - Screen.FFormList.Insert(0, ACustomForm); - end; -end; - // included by forms.pp diff --git a/packager/basepkgmanager.pas b/packager/basepkgmanager.pas index 84a6bc0ed9..bee83545dc 100644 --- a/packager/basepkgmanager.pas +++ b/packager/basepkgmanager.pas @@ -86,6 +86,8 @@ type procedure DoShowPackageGraphPathList(PathList: TList); virtual; abstract; function DoCompilePackage(APackage: TLazPackage; Flags: TPkgCompileFlags): TModalResult; virtual; abstract; + function DoSavePackageMainSource(APackage: TLazPackage; + Flags: TPkgCompileFlags): TModalResult; virtual; abstract; end; var diff --git a/packager/packagedefs.pas b/packager/packagedefs.pas index cca8cf9f6e..461bc65970 100644 --- a/packager/packagedefs.pas +++ b/packager/packagedefs.pas @@ -337,7 +337,8 @@ type // package requires this package) lpfVisited, // Used by the PackageGraph to avoid double checking lpfDestroying, // set during destruction - lpfSkipSaving + lpfSkipSaving, + lpfCircle ); TLazPackageFlags = set of TLazPackageFlag; @@ -458,7 +459,7 @@ type procedure UpdateEditorRect; procedure GetAllRequiredPackages(var List: TList); procedure GetInheritedCompilerOptions(var OptionsList: TList); - function GetCompileSourceFilenname: string; + function GetCompileSourceFilename: string; public property Author: string read FAuthor write SetAuthor; property AutoCreated: boolean read FAutoCreated write SetAutoCreated; @@ -521,7 +522,7 @@ const 'RunTime', 'DesignTime', 'RunAndDesignTime'); LazPackageFlagNames: array[TLazPackageFlag] of string = ( 'lpfAutoIncrementVersionOnBuild', 'lpfModified', 'lpfAutoUpdate', - 'lpfNeeded', 'lpfVisited', 'lpfDestroying', 'lpfSkipSaving'); + 'lpfNeeded', 'lpfVisited', 'lpfDestroying', 'lpfSkipSaving', 'lpfCircle'); var // All TPkgDependency are added to this AVL tree (sorted for names, not version!) @@ -2046,7 +2047,7 @@ begin end; end; -function TLazPackage.GetCompileSourceFilenname: string; +function TLazPackage.GetCompileSourceFilename: string; begin Result:=ChangeFileExt(ExtractFilename(Filename),'.pas'); end; @@ -2281,7 +2282,7 @@ end; function TPkgCompilerOptions.GetDefaultMainSourceFileName: string; begin - Result:=LazPackage.GetCompileSourceFilenname; + Result:=LazPackage.GetCompileSourceFilename; if Result='' then Result:=inherited GetDefaultMainSourceFileName; end; diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index 283ae7218e..c30690840a 100644 --- a/packager/packagesystem.pas +++ b/packager/packagesystem.pas @@ -153,6 +153,7 @@ type procedure MarkAllPackagesAsNotVisited; procedure MarkNeededPackages; function FindBrokenDependencyPath(APackage: TLazPackage): TList; + function FindCircleDependencyPath(APackage: TLazPackage): TList; public // packages handling function CreateNewPackage(const Prefix: string): TLazPackage; @@ -957,7 +958,7 @@ function TLazPackageGraph.FindBrokenDependencyPath(APackage: TLazPackage FindBroken(RequiredPackage,PathList); if PathList<>nil then begin // broken dependency found - // -> add current package to list to + // -> add current package to list PathList.Insert(0,CurPackage); exit; end; @@ -976,11 +977,60 @@ function TLazPackageGraph.FindBrokenDependencyPath(APackage: TLazPackage begin Result:=nil; if (Count=0) or (APackage=nil) then exit; - // mark all packages as not visited MarkAllPackagesAsNotVisited; FindBroken(APackage,Result); end; +function TLazPackageGraph.FindCircleDependencyPath(APackage: TLazPackage + ): TList; + + procedure FindCircle(CurPackage: TLazPackage; var PathList: TList); + var + Dependency: TPkgDependency; + RequiredPackage: TLazPackage; + begin + CurPackage.Flags:=CurPackage.Flags+[lpfVisited,lpfCircle]; + Dependency:=CurPackage.FirstRequiredDependency; + while Dependency<>nil do begin + if Dependency.LoadPackageResult=lprSuccess then begin + // dependency ok + RequiredPackage:=Dependency.RequiredPackage; + if lpfCircle in RequiredPackage.Flags then begin + // circle detected + PathList:=TList.Create; + PathList.Add(CurPackage); + PathList.Add(RequiredPackage); + exit; + end; + if not (lpfVisited in RequiredPackage.Flags) then begin + FindCircle(RequiredPackage,PathList); + if PathList<>nil then begin + // circle detected + // -> add current package to list + PathList.Insert(0,CurPackage); + exit; + end; + end; + end; + Dependency:=Dependency.NextRequiresDependency; + end; + CurPackage.Flags:=CurPackage.Flags-[lpfCircle]; + end; + +var + i: Integer; + Pkg: TLazPackage; +begin + Result:=nil; + if (Count=0) or (APackage=nil) then exit; + // mark all packages as not visited and circle free + for i:=FItems.Count-1 downto 0 do begin + Pkg:=TLazPackage(FItems[i]); + Pkg.Flags:=Pkg.Flags-[lpfVisited,lpfCircle]; + end; + FindCircle(APackage,Result); +end; + procedure TLazPackageGraph.MarkAllPackagesAsNotVisited; var i: Integer; diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index f958f46192..f2e48c997a 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -111,6 +111,8 @@ type procedure DoShowPackageGraphPathList(PathList: TList); override; function DoCompilePackage(APackage: TLazPackage; Flags: TPkgCompileFlags): TModalResult; override; + function DoSavePackageMainSource(APackage: TLazPackage; + Flags: TPkgCompileFlags): TModalResult; override; end; implementation @@ -831,7 +833,8 @@ begin // backup old file Result:=MainIDE.DoBackupFile(APackage.Filename,false); if Result=mrAbort then exit; - + + // delete ambigious files Result:=MainIDE.DoDeleteAmbigiousFiles(APackage.Filename); if Result=mrAbort then exit; @@ -903,6 +906,7 @@ var PathList: TList; begin Result:=mrCancel; + if APackage.AutoCreated then exit; // check for broken dependencies @@ -916,7 +920,105 @@ begin end; // check for circle dependencies + PathList:=PackageGraph.FindCircleDependencyPath(APackage); + if PathList<>nil then begin + DoShowPackageGraphPathList(PathList); + Result:=MessageDlg('Circle in package dependencies', + 'There is a circle in the required packages. See package graph.', + mtError,[mbCancel,mbAbort],0); + exit; + end; + // save everything + Result:=MainIDE.DoSaveForBuild; + if Result<>mrOk then exit; + + // create package main source file + Result:=DoSavePackageMainSource(APackage,Flags); + if Result<>mrOk then exit; + + Result:=mrOk; +end; + +function TPkgManager.DoSavePackageMainSource(APackage: TLazPackage; + Flags: TPkgCompileFlags): TModalResult; +var + SrcFilename: String; + UsedUnits: String; + Src: String; + i: Integer; + e: String; + CurFile: TPkgFile; + CodeBuffer: TCodeBuffer; + CurUnitName: String; +begin + // check if package is ready for saving + if not APackage.HasDirectory then begin + Result:=MessageDlg('Package has no directory', + 'Package "'+APackage.IDAsString+'" has no valid directory.', + mtError,[mbCancel,mbAbort],0); + exit; + end; + + SrcFilename:=APackage.Directory+APackage.GetCompileSourceFilename; + + // backup old file + Result:=MainIDE.DoBackupFile(SrcFilename,false); + if Result=mrAbort then exit; + + // delete ambigious files + Result:=MainIDE.DoDeleteAmbigiousFiles(SrcFilename); + if Result=mrAbort then exit; + + // collect unitnames + UsedUnits:=''; + for i:=0 to APackage.FileCount-1 do begin + CurFile:=APackage.Files[i]; + // update unitname + if FilenameIsPascalUnit(CurFile.Filename) + and (CurFile.FileType=pftUnit) then begin + CodeBuffer:=CodeToolBoss.LoadFile(CurFile.Filename,true,false); + if CodeBuffer<>nil then begin + CurUnitName:=CodeToolBoss.GetCachedSourceName(CodeBuffer); + if AnsiCompareText(CurUnitName,CurFile.UnitName)<>0 then begin + CurUnitName:=CodeToolBoss.GetSourceName(CodeBuffer,false); + end; + if AnsiCompareText(CurUnitName,CurFile.UnitName)=0 then begin + CurFile.UnitName:=CurUnitName; + end; + end; + CurUnitName:=CurFile.UnitName; + if (CurUnitName<>'') and IsValidIdent(CurUnitName) then begin + if UsedUnits<>'' then + UsedUnits:=UsedUnits+', '; + UsedUnits:=UsedUnits+CurUnitName; + end; + end; + end; + + // create source + e:=EndOfLine; + Src:='{ This is an automatically created source file. Do not edit!'+e + +' This source is only used to compile the package '+APackage.IDAsString+e + +'}'+e + +e + +'interface'+e + +e + +'uses'+e + +' '+UsedUnits+', Classes;'+e + +e + +'procedure Register;'+e + +e + +'implementation'+e + +e + +'procedure Register;'+e + +'begin'+e + +e + +'end;'+e + +e + +'end.'+e; + writeln(Src); + Result:=mrOk; end;