From 5d66571b44a307f32e52527c0182633cd56e80d8 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 12 May 2008 16:59:43 +0000 Subject: [PATCH] IDE: implemented parsing LCLVersion from lfm, added ResourceBaseClass to TUnitInfo and TPkgFile git-svn-id: trunk@15106 - --- components/codetools/lfmtrees.pas | 197 ++++++++++++++++++---- components/codetools/pascalparsertool.pas | 2 +- converter/delphiproject2laz.pas | 2 +- designer/changeclassdialog.pas | 2 +- ide/checklfmdlg.pas | 58 ++++++- ide/main.pp | 8 +- ide/project.pp | 33 +++- packager/packagedefs.pas | 64 ++++++- 8 files changed, 300 insertions(+), 66 deletions(-) diff --git a/components/codetools/lfmtrees.pas b/components/codetools/lfmtrees.pas index d62c3866c7..52e48c15bb 100644 --- a/components/codetools/lfmtrees.pas +++ b/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 - Parser.NextToken; // Get next string fragment + while NextToken = '+' do begin + 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.EndPos:=NewNode.StartPos; + NewNode.StartPos:=TokenStart; + 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; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 23c4371988..832fe12fdc 100644 --- a/components/codetools/pascalparsertool.pas +++ b/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 diff --git a/converter/delphiproject2laz.pas b/converter/delphiproject2laz.pas index 3bea735452..fbba9058a2 100644 --- a/converter/delphiproject2laz.pas +++ b/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); diff --git a/designer/changeclassdialog.pas b/designer/changeclassdialog.pas index 2182224be4..987857745f 100644 --- a/designer/changeclassdialog.pas +++ b/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; diff --git a/ide/checklfmdlg.pas b/ide/checklfmdlg.pas index bd453ad971..30fc6ab2f4 100644 --- a/ide/checklfmdlg.pas +++ b/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, - ObjectsMustExists); + Result:=RepairLFMBuffer(PascalBuffer,LFMBuf,OnOutput,RootMustBeClassInIntf, + ObjectsMustExists); LFMText:=LFMBuf.Source; finally CodeToolBoss.ReleaseTempFile(LFMBuf); diff --git a/ide/main.pp b/ide/main.pp index 2b51bd186a..1e50409190 100644 --- a/ide/main.pp +++ b/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, - true,true)<>mrOk + if RepairLFMBuffer(PascalBuf,LFMUnitInfo.Source,@MessagesView.AddMsg, + true,true)<>mrOk then begin DoJumpToCompilerMessage(-1,true); end; diff --git a/ide/project.pp b/ide/project.pp index f187bd4d84..c8a9707953 100644 --- a/ide/project.pp +++ b/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 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); diff --git a/packager/packagedefs.pas b/packager/packagedefs.pas index f8e76900ad..7daa585f60 100644 --- a/packager/packagedefs.pas +++ b/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 ComponentPriority: TComponentPriority read FComponentPriority - write FComponentPriority; - property Components[Index: integer]: TPkgComponent read GetComponents; + property Removed: boolean read FRemoved write SetRemoved; property SourceDirectoryReferenced: boolean read FSourceDirectoryReferenced; - property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir - write SetAutoReferenceSourceDir; + property UnitName: string read FUnitName write FUnitName; 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;