fixed codetools Makefile, fixed default prop not found error

git-svn-id: trunk@4066 -

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)

components/codetools/Makefile.fpc

@@ -12,6 +12,7 @@ packages=fcl
 
 [compiler]
 unittargetdir=../units
+unitdir=.
 options=-gl
 
 [target]

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);

components/synedit/Makefile.fpc

@@ -9,7 +9,7 @@ version=0.8a
 
 [compiler]
 unittargetdir=../units
-unitdir=../../lcl/units
+unitdir=../../lcl/units .
 options=-gl
 
 [target]

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;

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;

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
 

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
 

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

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;

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;

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;