IDE: implemented parsing LCLVersion from lfm, added ResourceBaseClass to TUnitInfo and TPkgFile

git-svn-id: trunk@15106 -

components/codetools/lfmtrees.pas

@@ -30,7 +30,8 @@ unit LFMTrees;
 interface
 
 uses
-  Classes, SysUtils, AVL_Tree, FileProcs, CodeCache, CodeAtom, TypInfo;
+  Classes, SysUtils, AVL_Tree, FileProcs, BasicCodeTools, CodeCache, CodeAtom,
+  TypInfo;
   
 type
   { TLFMTreeNode }
@@ -132,6 +133,7 @@ type
   public
     ValueType: TLFMValueType;
     constructor CreateVirtual; override;
+    function ReadString: string;
   end;
 
 
@@ -238,6 +240,8 @@ type
   TLFMTree = class
   protected
     Parser: TParser;
+    TokenStart: LongInt;
+    function NextToken: Char;
     procedure ProcessValue;
     procedure ProcessProperty;
     procedure ProcessObject;
@@ -266,6 +270,11 @@ type
     function FindErrorAtNode(Node: TLFMTreeNode): TLFMError;
     function FindError(ErrorTypes: TLFMErrorTypes): TLFMError;
     function FirstErrorAsString: string;
+
+    function FindProperty(PropertyPath: string;
+                          ContextNode: TLFMTreeNode): TLFMPropertyNode;
+
+    procedure WriteDebugReport;
   end;
   
   { TLFMTrees }
@@ -301,6 +310,18 @@ const
     'EndNotFound'
     );
     
+  TLFMValueTypeNames: array[TLFMValueType] of string = (
+    'None',
+    'Integer',
+    'Float',
+    'String',
+    'Symbol',
+    'Set',
+    'List',
+    'Collection',
+    'Binary'
+    );
+    
 procedure FreeListOfPInstancePropInfo(List: TFPList);
 function CompareLFMTreesByLFMBuffer(Data1, Data2: Pointer): integer;
 function CompareLFMBufWithTree(Buf, Tree: Pointer): integer;
@@ -334,6 +355,7 @@ begin
   Result:=ComparePointers(Buf,TLFMTree(Tree).LFMBuffer);
 end;
 
+
 { TLFMTree }
 
 constructor TLFMTree.Create;
@@ -349,7 +371,8 @@ end;
 
 procedure TLFMTree.Clear;
 begin
-  LFMBuffer:=nil;
+  // do not set LFMBuffer to nil
+  TokenStart:=0;
   CurNode:=nil;
   ClearErrors;
   while Root<>nil do Root.Free;
@@ -368,6 +391,8 @@ begin
   Result:=false;
   Clear;
   if LFMBuf<>LFMBuffer then begin
+    DebugLn(['TLFMTree.Parse New=',LFMBuf.Filename]);
+    DebugLn(['TLFMTree.Parse Old=',LFMBuffer.Filename]);
     if Trees<>nil then
       raise Exception.Create('TLFMTree.Parse: changing LFMBuffer in Tree is not allowed');
     LFMBuffer:=LFMBuf;
@@ -466,10 +491,81 @@ begin
   if FirstError<>nil then Result:=FirstError.ErrorMessage;
 end;
 
+function TLFMTree.FindProperty(PropertyPath: string; ContextNode: TLFMTreeNode
+  ): TLFMPropertyNode;
+var
+  Node: TLFMTreeNode;
+  ObjNode: TLFMObjectNode;
+  p: LongInt;
+  FirstPart: String;
+  RestParts: String;
+begin
+  if ContextNode=nil then
+    Node:=Root
+  else
+    Node:=ContextNode.FirstChild;
+  p:=System.Pos(PropertyPath,'.');
+  FirstPart:=copy(PropertyPath,1,p-1);
+  RestParts:=copy(PropertyPath,p+1,length(PropertyPath));
+  while Node<>nil do begin
+    if Node is TLFMPropertyNode then begin
+      Result:=TLFMPropertyNode(Node);
+      if SysUtils.CompareText(Result.CompleteName,PropertyPath)=0 then
+        exit;
+    end else if (Node is TLFMObjectNode)
+    and (RestParts<>'') then begin
+      ObjNode:=TLFMObjectNode(Node);
+      if CompareIdentifierPtrs(Pointer(ObjNode.Name),Pointer(FirstPart))=0 then
+      begin
+        Result:=FindProperty(RestParts,ObjNode);
+        exit;
+      end;
+    end;
+    Node:=Node.NextSibling;
+  end;
+  Result:=nil;
+end;
+
+procedure TLFMTree.WriteDebugReport;
+var
+  Src: string;
+
+  procedure WriteNode(const Prefix: string; Node: TLFMTreeNode);
+  var
+    Child: TLFMTreeNode;
+    EndPos: LongInt;
+  begin
+    if Node=nil then exit;
+    Child:=Node.FirstChild;
+    EndPos:=Node.EndPos;
+    if (Child<>nil) and (EndPos>Child.StartPos) then
+      EndPos:=Child.StartPos;
+    DebugLn([Prefix,dbgstr(copy(Src,Node.StartPos,EndPos-Node.StartPos))]);
+    while Child<>nil do begin
+      WriteNode(Prefix+'  ',Child);
+      Child:=Child.NextSibling;
+    end;
+  end;
+
+begin
+  if LFMBuffer=nil then begin
+    DebugLn(['TLFMTree.WriteDebugReport LFMBuffer=nil']);
+  end;
+  DebugLn(['TLFMTree.WriteDebugReport ',LFMBuffer.Filename]);
+  Src:=LFMBuffer.Source;
+  WriteNode('',Root);
+end;
+
 {$if not declared(toWString)}
   const toWString = char(5);
 {$endif}
 
+function TLFMTree.NextToken: Char;
+begin
+  TokenStart:=Parser.SourcePos+1;
+  Result:=Parser.NextToken;
+end;
+
 procedure TLFMTree.ProcessValue;
 var
   s: String;
@@ -482,7 +578,7 @@ begin
     begin
       CreateChildNode(TLFMValueNode);
       TLFMValueNode(CurNode).ValueType:=lfmvInteger;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -490,7 +586,7 @@ begin
     begin
       CreateChildNode(TLFMValueNode);
       TLFMValueNode(CurNode).ValueType:=lfmvFloat;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -498,8 +594,8 @@ begin
     begin
       CreateChildNode(TLFMValueNode);
       TLFMValueNode(CurNode).ValueType:=lfmvString;
-      while Parser.NextToken = '+' do begin
+      while NextToken = '+' do begin
-        Parser.NextToken;   // Get next string fragment
+        NextToken;   // Get next string fragment
         if not (Parser.Token in [toString,toWString]) then
           Parser.CheckToken(toString);
       end;
@@ -512,13 +608,13 @@ begin
       SymbolNode:=TLFMValueNodeSymbol(CurNode);
       if SymbolNode=nil then ;
       s := Parser.TokenString;
-      if CompareText(s, 'End') = 0 then
+      if SysUtils.CompareText(s, 'End') = 0 then
         SymbolNode.SymbolType:=lfmsNone
-      else if CompareText(s, 'True') = 0 then
+      else if SysUtils.CompareText(s, 'True') = 0 then
         SymbolNode.SymbolType:=lfmsTrue
-      else if CompareText(s, 'False') = 0 then
+      else if SysUtils.CompareText(s, 'False') = 0 then
         SymbolNode.SymbolType:=lfmsFalse
-      else if CompareText(s, 'nil') = 0 then
+      else if SysUtils.CompareText(s, 'nil') = 0 then
         SymbolNode.SymbolType:=lfmsNil
       else
       begin
@@ -526,7 +622,7 @@ begin
         Parser.TokenComponentIdent;
       end;
       if SymbolNode.SymbolType<>lfmsNone then
-        Parser.NextToken;
+        NextToken;
       CloseChildNode;
     end;
     
@@ -534,20 +630,20 @@ begin
   '[':
     begin
       CreateChildNode(TLFMValueNodeSet);
-      Parser.NextToken;
+      NextToken;
       if Parser.Token <> ']' then
         while True do
         begin
           CreateChildNode(TLFMEnumNode);
           Parser.CheckToken(toSymbol);
           CloseChildNode;
-          Parser.NextToken;
+          NextToken;
           if Parser.Token = ']' then
             break;
           Parser.CheckToken(',');
-          Parser.NextToken;
+          NextToken;
         end;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -555,10 +651,10 @@ begin
   '(':
     begin
       CreateChildNode(TLFMValueNodeList);
-      Parser.NextToken;
+      NextToken;
       while Parser.Token <> ')' do
         ProcessValue;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -566,18 +662,18 @@ begin
   '<':
     begin
       CreateChildNode(TLFMValueNodeCollection);
-      Parser.NextToken;
+      NextToken;
       while Parser.Token <> '>' do
       begin
         Parser.CheckTokenSymbol('item');
-        Parser.NextToken;
+        NextToken;
         CreateChildNode(TLFMValueNodeList);
         while not Parser.TokenSymbolIs('end') do
           ProcessProperty;
-        Parser.NextToken;   // Skip 'end'
+        NextToken;   // Skip 'end'
         CloseChildNode;
       end;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -591,7 +687,7 @@ begin
       finally
         MemStream.Free;
       end;
-      Parser.NextToken;
+      NextToken;
       CloseChildNode;
     end;
     
@@ -611,14 +707,14 @@ begin
   Parser.CheckToken(toSymbol);
   PropertyNode.Add(Parser.TokenString,Parser.SourcePos+1);
   while True do begin
-    Parser.NextToken;
+    NextToken;
     if Parser.Token <> '.' then break;
-    Parser.NextToken;
+    NextToken;
     Parser.CheckToken(toSymbol);
     PropertyNode.Add(Parser.TokenString,Parser.SourcePos+1);
   end;
   Parser.CheckToken('=');
-  Parser.NextToken;
+  NextToken;
   ProcessValue;
   CloseChildNode;
 end;
@@ -636,7 +732,7 @@ begin
     Parser.CheckTokenSymbol('INHERITED');
     ObjectNode.IsInherited := True;
   end;
-  Parser.NextToken;
+  NextToken;
   Parser.CheckToken(toSymbol);
   if not Parser.TokenSymbolIs('END') then begin
     ObjectStartLine:=Parser.SourceLine;
@@ -644,21 +740,21 @@ begin
     ObjectNode.TypeName := Parser.TokenString;
     ObjectNode.TypeNamePosition:=Parser.SourcePos+1;
     ObjectNode.ChildPos := -1;
-    Parser.NextToken;
+    NextToken;
     if Parser.Token = ':' then begin
-      Parser.NextToken;
+      NextToken;
       Parser.CheckToken(toSymbol);
       ObjectNode.Name := ObjectNode.TypeName;
       ObjectNode.NamePosition:=ObjectNode.TypeNamePosition;
       ObjectNode.TypeName := Parser.TokenString;
       ObjectNode.TypeNamePosition:=Parser.SourcePos+1;
-      Parser.NextToken;
+      NextToken;
       if parser.Token = '[' then begin
-        parser.NextToken;
+        NextToken;
         ObjectNode.ChildPos := parser.TokenInt;
-        parser.NextToken;
+        NextToken;
         parser.CheckToken(']');
-        parser.NextToken;
+        NextToken;
       end;
     end;
 
@@ -678,7 +774,7 @@ begin
       ProcessObject;
     end;
   end;
-  Parser.NextToken; // Skip 'END' token
+  NextToken; // Skip 'END' token
   
   CloseChildNode;
 end;
@@ -689,8 +785,8 @@ var
 begin
   NewNode:=NodeClass.CreateVirtual;
   NewNode.Tree:=Self;
-  NewNode.StartPos:=Parser.SourcePos+1;
+  NewNode.StartPos:=TokenStart;
-  NewNode.EndPos:=NewNode.StartPos;
+  NewNode.EndPos:=0;
   if CurNode<>nil then begin
     CurNode.AddChild(NewNode);
   end else begin
@@ -701,7 +797,8 @@ end;
 
 procedure TLFMTree.CloseChildNode;
 begin
-  CurNode.EndPos:=Parser.SourcePos+1;
+  if CurNode.EndPos<1 then
+    CurNode.EndPos:=TokenStart;
   CurNode:=CurNode.Parent;
 end;
 
@@ -884,6 +981,34 @@ begin
   ValueType:=lfmvNone;
 end;
 
+function TLFMValueNode.ReadString: string;
+var
+  p: LongInt;
+  Src: String;
+  i: integer;
+  AtomStart: LongInt;
+begin
+  Result:='';
+  if ValueType<>lfmvString then exit;
+  p:=StartPos;
+  AtomStart:=p;
+  Src:=Tree.LFMBuffer.Source;
+  repeat
+    ReadRawNextPascalAtom(Src,p,AtomStart);
+    if AtomStart>length(Src) then exit;
+    if Src[AtomStart]='''' then begin
+      Result:=Result+copy(Src,AtomStart+1,p-AtomStart-2)
+    end else if Src[AtomStart]='+' then begin
+      // skip
+    end else if Src[AtomStart]='#' then begin
+      i:=StrToIntDef(copy(Src,AtomStart+1,p-AtomStart-1),-1);
+      if (i<0) or (i>255) then exit;
+      Result:=Result+chr(i);
+    end else
+      exit;
+  until false;
+end;
+
 { TLFMValueNodeSymbol }
 
 constructor TLFMValueNodeSymbol.CreateVirtual;

components/codetools/pascalparsertool.pas

@@ -4140,7 +4140,7 @@ begin
   if ProcNode.Desc=ctnProcedureHead then
     ProcNode:=ProcNode.Parent;
   if ProcNode.Desc<>ctnProcedure then
-    RaiseException('INTERNAL ERROR: TPascalParserTool.BuildSubTreeForProcHead');
+    RaiseException('INTERNAL ERROR: TPascalParserTool.BuildSubTreeForProcHead with FunctionResult');
   BuildSubTreeForProcHead(ProcNode);
   FunctionResult:=ProcNode.FirstChild.FirstChild;
   if (FunctionResult<>nil) and (FunctionResult.Desc=ctnParameterList) then

converter/delphiproject2laz.pas

@@ -727,7 +727,7 @@ begin
     if HasDFMFile and (LFMCode=nil) then
       DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode');
     if (LFMCode<>nil)
-    and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
+    and (RepairLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk)
     then begin
       LazarusIDE.DoJumpToCompilerMessage(-1,true);
       exit(mrAbort);

designer/changeclassdialog.pas

@@ -218,7 +218,7 @@ var
 
   function CheckProperties: boolean;
   begin
-    Result:=CheckLFMBuffer(UnitCode,LFMBuffer,nil,false,false)=mrOk;
+    Result:=RepairLFMBuffer(UnitCode,LFMBuffer,nil,false,false)=mrOk;
     if not Result and (CodeToolBoss.ErrorMessage<>'') then
       MainIDEInterface.DoJumpToCodeToolBossError;
   end;

ide/checklfmdlg.pas

@@ -39,7 +39,7 @@ uses
   SynHighlighterLFM, SynEdit, BasicCodeTools, CodeCache, CodeToolManager,
   LFMTrees,
   // IDE
-  PropEdits, ComponentReg, PackageIntf, IDEWindowIntf,
+  PropEdits, IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
   LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs, EditorOptions;
 
 type
@@ -77,16 +77,22 @@ type
     property LFMTree: TLFMTree read FLFMTree write SetLFMTree;
     property LFMSource: TCodeBuffer read FLFMSource write SetLFMSource;
   end;
-  
+
-function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
+// check and repair lfm files
+function QuickCheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
+  out LCLVersion: string;
+  out MissingClasses: TStrings// e.g. MyFrame2:TMyFrame
+  ): TModalResult;
+function RepairLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
   const OnOutput: TOnAddFilteredLine;
   RootMustBeClassInIntf, ObjectsMustExists: boolean): TModalResult;
-function CheckLFMText(PascalBuffer: TCodeBuffer; var LFMText: string;
+function RepairLFMText(PascalBuffer: TCodeBuffer; var LFMText: string;
   const OnOutput: TOnAddFilteredLine;
   RootMustBeClassInIntf, ObjectsMustExists: boolean): TModalResult;
 function ShowRepairLFMWizard(LFMBuffer: TCodeBuffer;
   LFMTree: TLFMTree): TModalResult;
 
+// dangling events
 function RemoveDanglingEvents(RootComponent: TComponent;
   PascalBuffer: TCodeBuffer; OkOnCodeErrors: boolean;
   out ComponentModified: boolean): TModalResult;
@@ -101,7 +107,42 @@ type
     NewText: string;
   end;
 
-function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
+function QuickCheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer; out
+  LCLVersion: string; out MissingClasses: TStrings): TModalResult;
+var
+  LFMTree: TLFMTree;
+  LCLVersionNode: TLFMPropertyNode;
+  LCLVersionValueNode: TLFMValueNode;
+begin
+  DebugLn(['QuickCheckLFMBuffer LFMBuffer=',LFMBuffer.Filename]);
+  LCLVersion:='';
+  MissingClasses:=nil;
+
+  LFMTree:=DefaultLFMTrees.GetLFMTree(LFMBuffer,true);
+  if not LFMTree.ParseIfNeeded then begin
+    DebugLn(['QuickCheckLFMBuffer LFM error: ',LFMTree.FirstErrorAsString]);
+    exit(mrCancel);
+  end;
+  
+  //LFMTree.WriteDebugReport;
+
+  // first search the version
+  LCLVersionNode:=LFMTree.FindProperty('LCLVersion',LFMTree.Root);
+  //DebugLn(['QuickCheckLFMBuffer LCLVersionNode=',LCLVersionNode<>nil]);
+  if (LCLVersionNode<>nil) and (LCLVersionNode.FirstChild is TLFMValueNode) then
+  begin
+    LCLVersionValueNode:=TLFMValueNode(LCLVersionNode.FirstChild);
+    //DebugLn(['QuickCheckLFMBuffer ',TLFMValueTypeNames[LCLVersionValueNode.ValueType]]);
+    if LCLVersionValueNode.ValueType=lfmvString then begin
+      LCLVersion:=LCLVersionValueNode.ReadString;
+      //DebugLn(['QuickCheckLFMBuffer LCLVersion=',LCLVersion]);
+    end;
+  end;
+  
+  Result:=mrOk;
+end;
+
+function RepairLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
   const OnOutput: TOnAddFilteredLine;
   RootMustBeClassInIntf, ObjectsMustExists: boolean): TModalResult;
 var
@@ -257,7 +298,6 @@ begin
     DebugLn(['CheckLFMBuffer failed parsing unit: ',PascalBuffer.Filename]);
     exit;
   end;
-
   if CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,LFMTree,
                            RootMustBeClassInIntf,ObjectsMustExists)
   then begin
@@ -274,7 +314,7 @@ begin
   Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree);
 end;
 
-function CheckLFMText(PascalBuffer: TCodeBuffer; var LFMText: string;
+function RepairLFMText(PascalBuffer: TCodeBuffer; var LFMText: string;
   const OnOutput: TOnAddFilteredLine;
   RootMustBeClassInIntf, ObjectsMustExists: boolean): TModalResult;
 var
@@ -284,8 +324,8 @@ begin
   LFMBuf:=CodeToolBoss.CreateTempFile('temp.lfm');
   try
     LFMBuf.Source:=LFMText;
-    Result:=CheckLFMBuffer(PascalBuffer,LFMBuf,OnOutput,RootMustBeClassInIntf,
+    Result:=RepairLFMBuffer(PascalBuffer,LFMBuf,OnOutput,RootMustBeClassInIntf,
-                           ObjectsMustExists);
+                            ObjectsMustExists);
     LFMText:=LFMBuf.Source;
   finally
     CodeToolBoss.ReleaseTempFile(LFMBuf);

ide/main.pp

@@ -5401,6 +5401,8 @@ var
   NewUnitName: String;
   AncestorUnitInfo: TUnitInfo;
   ReferencesLocked: Boolean;
+  LCLVersion: string;
+  MissingClasses: TStrings;
 begin
   debugln('TMainIDE.DoLoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
 
@@ -5444,6 +5446,8 @@ begin
 
     if AnUnitInfo.Component=nil then begin
       // load/create new instance
+      
+      QuickCheckLFMBuffer(AnUnitInfo.Source,LFMBuf,LCLVersion,MissingClasses);
 
       // find the classname of the LFM, and check for inherited form
       ReadLFMHeader(LFMBuf.Source,NewClassName,LFMType);
@@ -9924,8 +9928,8 @@ begin
   DoArrangeSourceEditorAndMessageView(false);
 
   // parse the LFM file and the pascal unit
-  if CheckLFMBuffer(PascalBuf,LFMUnitInfo.Source,@MessagesView.AddMsg,
+  if RepairLFMBuffer(PascalBuf,LFMUnitInfo.Source,@MessagesView.AddMsg,
-                    true,true)<>mrOk
+                     true,true)<>mrOk
   then begin
     DoJumpToCompilerMessage(-1,true);
   end;

ide/project.pp

@@ -155,7 +155,7 @@ type
     uifMarked
     );
   TUnitInfoFlags = set of TUnitInfoFlag;
-
+  
   { TUnitInfo }
 
   TUnitInfo = class(TLazProjectFile)
@@ -165,6 +165,7 @@ type
     fBookmarks: TFileBookmarks;
     FBuildFileIfActive: boolean;
     fComponent: TComponent;
+    FResourceBaseClass: TPFComponentBaseClass;
     fComponentName: string; { classname is always T<ComponentName>
          this attribute contains the component name,
          even if the unit is not loaded,
@@ -176,6 +177,7 @@ type
     FComponentLastLRSStreamSize: TStreamSeekType;
     fCursorPos: TPoint;
     fCustomHighlighter: boolean; // do not change highlighter on file extension change
+    FDirectives: TStrings;
     fEditorIndex: integer;
     fFileName: string;
     fFileReadOnly: Boolean;
@@ -222,6 +224,7 @@ type
     function GetPrevUnitWithEditorIndex: TUnitInfo;
     procedure SetAutoReferenceSourceDir(const AValue: boolean);
     procedure SetBuildFileIfActive(const AValue: boolean);
+    procedure SetDirectives(const AValue: TStrings);
     procedure SetEditorIndex(const AValue: integer);
     procedure SetFileReadOnly(const AValue: Boolean);
     procedure SetComponent(const AValue: TComponent);
@@ -264,12 +267,12 @@ type
     procedure IgnoreCurrentFileDateOnDisk;
     procedure IncreaseAutoRevertLock;
     procedure DecreaseAutoRevertLock;
-    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
-                                Merge: boolean);
     function ParseUnitNameFromSource(TryCache: boolean): string;
     procedure ReadUnitNameFromSource(TryCache: boolean);
     function CreateUnitName: string;
     procedure ImproveUnitNameCache(const NewUnitName: string);
+    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
+                                Merge: boolean);
     procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
                               SaveData, SaveSession: boolean);
     procedure UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended);
@@ -315,6 +318,8 @@ type
     property ComponentName: string read fComponentName write fComponentName;
     property ComponentResourceName: string read fComponentResourceName
                                            write fComponentResourceName;
+    property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass
+                                                      write FResourceBaseClass;
     property ComponentLastBinStreamSize: TStreamSeekType
              read FComponentLastBinStreamSize write FComponentLastBinStreamSize;
     property ComponentLastLRSStreamSize: TStreamSeekType
@@ -324,7 +329,7 @@ type
     property CursorPos: TPoint read fCursorPos write fCursorPos; // physical (screen) position
     property CustomHighlighter: boolean
                                read fCustomHighlighter write fCustomHighlighter;
-    property Directives: TStrings;
+    property Directives: TStrings read FDirectives write SetDirectives;
     property EditorIndex: integer read fEditorIndex write SetEditorIndex;
     property FileReadOnly: Boolean read fFileReadOnly write SetFileReadOnly;
     property FirstRequiredComponent: TUnitComponentDependency
@@ -869,14 +874,14 @@ type
     property EnableI18N: boolean read FEnableI18N write SetEnableI18N;
     property POOutputDirectory: string read FPOOutputDirectory
                                        write SetPOOutputDirectory;
-
   end;
 
+  
 const
   ResourceFileExt = '.lrs';
 
 var
-  Project1: TProject = nil;
+  Project1: TProject = nil;// the main project
 
 procedure AddCompileReasonsDiff(Tool: TCompilerDiffTool;
   const PropertyName: string; const Old, New: TCompileReasons);
@@ -1148,6 +1153,9 @@ begin
     XMLConfig.SetDeleteValue(Path+'ComponentName/Value',fComponentName,'');
     XMLConfig.SetDeleteValue(Path+'HasResources/Value',fHasResources,false);
     XMLConfig.SetDeleteValue(Path+'IsPartOfProject/Value',IsPartOfProject,false);
+    XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value',
+                             PFComponentBaseClassNames[FResourceBaseClass],
+                             PFComponentBaseClassNames[pfcbcNone]);
     AFilename:=FResourceFilename;
     if Assigned(fOnLoadSaveFilename) then
       fOnLoadSaveFilename(AFilename,false);
@@ -1198,6 +1206,8 @@ begin
     if fComponentName='' then
       fComponentName:=XMLConfig.GetValue(Path+'FormName/Value','');
     HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false);
+    FResourceBaseClass:=StrToComponentBaseClass(
+                         XMLConfig.GetValue(Path+'ResourceBaseClass/Value',''));
     IsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false);
     AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value','');
     if (AFilename<>'') and Assigned(fOnLoadSaveFilename) then
@@ -1695,6 +1705,12 @@ begin
   SessionModified:=true;
 end;
 
+procedure TUnitInfo.SetDirectives(const AValue: TStrings);
+begin
+  if FDirectives=AValue then exit;
+  FDirectives:=AValue;
+end;
+
 procedure TUnitInfo.SetEditorIndex(const AValue: integer);
 begin
   if fEditorIndex=AValue then exit;
@@ -1717,7 +1733,10 @@ begin
   if fComponent=AValue then exit;
   fComponent:=AValue;
   UpdateList(uilWithComponent,fComponent<>nil);
-  if fComponent=nil then ClearComponentDependencies;
+  if fComponent=nil then
+    ClearComponentDependencies
+  else
+    FResourceBaseClass:=GetComponentBaseClass(fComponent.ClassType);
 end;
 
 procedure TUnitInfo.SetIsPartOfProject(const AValue: boolean);

packager/packagedefs.pas

@@ -147,6 +147,25 @@ type
 const
   PkgFileUnitTypes = [pftUnit,pftVirtualUnit];
   
+type
+  TPFComponentBaseClass = (
+    pfcbcNone,      // unknown
+    pfcbcForm,      // is TForm
+    pfcbcFrame,     // is TFrame
+    pfcbcDataModule // is TDataModule
+    );
+    
+const
+  PFComponentBaseClassNames: array[TPFComponentBaseClass] of string = (
+    'None',
+    'Form',
+    'Frame',
+    'DataModule'
+    );
+    
+function StrToComponentBaseClass(const s: string): TPFComponentBaseClass;
+function GetComponentBaseClass(aClass: TClass): TPFComponentBaseClass;
+
 type
   TPkgFileFlag = (
     pffHasRegisterProc,  // file is unit and has a 'register' procedure
@@ -170,6 +189,7 @@ type
     fFullFilename: string;
     fFullFilenameStamp: integer;
     FPackage: TLazPackage;
+    FResourceBaseClass: TPFComponentBaseClass;
     FSourceDirectoryReferenced: boolean;
     FSourceDirNeedReference: boolean;
     FUnitName: string;
@@ -204,23 +224,25 @@ type
     procedure UpdateSourceDirectoryReference;
     function GetFullFilename: string;
   public
-    property Removed: boolean read FRemoved write SetRemoved;
+    property AddToUsesPkgSection: boolean
+                       read GetAddToUsesPkgSection write SetAddToUsesPkgSection;
+    property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir
+                                             write SetAutoReferenceSourceDir;
+    property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass
+                                                      write FResourceBaseClass;
+    property ComponentPriority: TComponentPriority read FComponentPriority
+                                                   write FComponentPriority;
+    property Components[Index: integer]: TPkgComponent read GetComponents;// registered components
     property Directory: string read FDirectory;
     property Filename: string read FFilename write SetFilename;
     property FileType: TPkgFileType read FFileType write SetFileType;
     property Flags: TPkgFileFlags read FFlags write SetFlags;
     property HasRegisterProc: boolean
                                read GetHasRegisterProc write SetHasRegisterProc;
-    property AddToUsesPkgSection: boolean
-                       read GetAddToUsesPkgSection write SetAddToUsesPkgSection;
     property LazPackage: TLazPackage read FPackage;
-    property UnitName: string read FUnitName write FUnitName;
+    property Removed: boolean read FRemoved write SetRemoved;
-    property ComponentPriority: TComponentPriority read FComponentPriority
-                                                   write FComponentPriority;
-    property Components[Index: integer]: TPkgComponent read GetComponents;
     property SourceDirectoryReferenced: boolean read FSourceDirectoryReferenced;
-    property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir
+    property UnitName: string read FUnitName write FUnitName;
-                                             write SetAutoReferenceSourceDir;
   end;
   
   
@@ -1109,6 +1131,25 @@ begin
   end;
 end;
 
+function StrToComponentBaseClass(const s: string): TPFComponentBaseClass;
+begin
+  for Result:=low(TPFComponentBaseClass) to high(TPFComponentBaseClass) do
+    if SysUtils.CompareText(PFComponentBaseClassNames[Result],s)=0 then exit;
+  Result:=pfcbcNone;
+end;
+
+function GetComponentBaseClass(aClass: TClass): TPFComponentBaseClass;
+begin
+  Result:=pfcbcNone;
+  if aClass=nil then exit;
+  if aClass.InheritsFrom(TForm) then
+    Result:=pfcbcForm
+  else if aClass.InheritsFrom(TFrame) then
+    Result:=pfcbcFrame
+  else if aClass.InheritsFrom(TDataModule) then
+    Result:=pfcbcDataModule;
+end;
+
 function CompareLazPackageID(Data1, Data2: Pointer): integer;
 var
   Pkg1: TLazPackageID;
@@ -1541,6 +1582,8 @@ begin
     if CompareText(fUnitName,CaseInsensitiveUnitName)<>0 then
       fUnitName:=CaseInsensitiveUnitName;
   end;
+  FResourceBaseClass:=StrToComponentBaseClass(
+                         XMLConfig.GetValue(Path+'ResourceBaseClass/Value',''));
 end;
 
 procedure TPkgFile.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
@@ -1557,6 +1600,9 @@ begin
   XMLConfig.SetDeleteValue(Path+'Type/Value',PkgFileTypeIdents[FileType],
                            PkgFileTypeIdents[pftUnit]);
   XMLConfig.SetDeleteValue(Path+'UnitName/Value',FUnitName,'');
+  XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value',
+                           PFComponentBaseClassNames[FResourceBaseClass],
+                           PFComponentBaseClassNames[pfcbcNone]);
 end;
 
 procedure TPkgFile.ConsistencyCheck;