diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 58e8108f67..aa024b540f 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -209,7 +209,7 @@ type // TDefineTree caches the define values for directories TOnReadValue = procedure(Sender: TObject; const VariableName: string; var Value: string) of object; - + TDefineTreeSavePolicy = ( dtspAll, // save all DefineTemplates dtspProjectSpecific, // save all (not auto) and project specific nodes @@ -223,6 +223,12 @@ type TOnGetVirtualDirectoryAlias = procedure(Sender: TObject; var RealDir: string) of object; + + TReadFunctionData = record + Param: string; + Result: string; + end; + PReadFunctionData = ^TReadFunctionData; TDefineTree = class private @@ -231,6 +237,7 @@ type FChangeStep: integer; FErrorDescription: string; FErrorTemplate: TDefineTemplate; + FMacroFunctions: TKeyWordFunctionList; FOnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias; FOnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines; FOnReadValue: TOnReadValue; @@ -239,59 +246,64 @@ type procedure IncreaseChangeStep; protected function FindDirectoryInCache(const Path: string): TDirectoryDefines; + function MacroFuncExtractFileExt(Data: Pointer): boolean; + function MacroFuncExtractFilePath(Data: Pointer): boolean; + function MacroFuncExtractFileName(Data: Pointer): boolean; + function MacroFuncExtractFileNameOnly(Data: Pointer): boolean; public property RootTemplate: TDefineTemplate - read FFirstDefineTemplate write FFirstDefineTemplate; + read FFirstDefineTemplate write FFirstDefineTemplate; property ChangeStep: integer read FChangeStep; property ErrorTemplate: TDefineTemplate read FErrorTemplate; property ErrorDescription: string read FErrorDescription; property OnGetVirtualDirectoryAlias: TOnGetVirtualDirectoryAlias - read FOnGetVirtualDirectoryAlias write FOnGetVirtualDirectoryAlias; + read FOnGetVirtualDirectoryAlias write FOnGetVirtualDirectoryAlias; property OnGetVirtualDirectoryDefines: TOnGetVirtualDirectoryDefines - read FOnGetVirtualDirectoryDefines write FOnGetVirtualDirectoryDefines; + read FOnGetVirtualDirectoryDefines write FOnGetVirtualDirectoryDefines; property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue; + property MacroFunctions: TKeyWordFunctionList read FMacroFunctions; public - function GetDefinesForDirectory(const Path: string; - WithVirtualDir: boolean): TExpressionEvaluator; - function GetDefinesForVirtualDirectory: TExpressionEvaluator; - procedure AddFirst(ADefineTemplate: TDefineTemplate); - procedure Add(ADefineTemplate: TDefineTemplate); - function FindDefineTemplateByName(const AName: string; - OnlyRoots: boolean): TDefineTemplate; - procedure ReplaceRootSameName(const Name: string; - ADefineTemplate: TDefineTemplate); - procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate); - procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate); - procedure RemoveRootDefineTemplateByName(const AName: string); - procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate; - const ChildName: string); - procedure AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate); - function LoadFromXMLConfig(XMLConfig: TXMLConfig; - const Path: string; Policy: TDefineTreeLoadPolicy; - const NewNamePrefix: string): boolean; - function SaveToXMLConfig(XMLConfig: TXMLConfig; - const Path: string; Policy: TDefineTreeSavePolicy): boolean; - procedure ClearCache; - procedure Clear; - function IsEqual(SrcDefineTree: TDefineTree): boolean; - procedure Assign(SrcDefineTree: TDefineTree); - procedure RemoveMarked; - procedure RemoveGlobals; - procedure RemoveProjectSpecificOnly; - procedure RemoveProjectSpecificAndParents; - procedure RemoveNonAutoCreated; - function GetUnitPathForDirectory(const Directory: string): string; - function GetIncludePathForDirectory(const Directory: string): string; - function GetSrcPathForDirectory(const Directory: string): string; - function GetPPUSrcPathForDirectory(const Directory: string): string; - function GetPPWSrcPathForDirectory(const Directory: string): string; - function GetDCUSrcPathForDirectory(const Directory: string): string; - function GetCompiledSrcPathForDirectory(const Directory: string): string; - procedure ReadValue(const DirDef: TDirectoryDefines; - const PreValue, CurDefinePath: string; var NewValue: string); constructor Create; destructor Destroy; override; function ConsistencyCheck: integer; // 0 = ok + function FindDefineTemplateByName(const AName: string; + OnlyRoots: boolean): TDefineTemplate; + function GetCompiledSrcPathForDirectory(const Directory: string): string; + function GetDCUSrcPathForDirectory(const Directory: string): string; + function GetDefinesForDirectory(const Path: string; + WithVirtualDir: boolean): TExpressionEvaluator; + function GetDefinesForVirtualDirectory: TExpressionEvaluator; + function GetIncludePathForDirectory(const Directory: string): string; + function GetPPUSrcPathForDirectory(const Directory: string): string; + function GetPPWSrcPathForDirectory(const Directory: string): string; + function GetSrcPathForDirectory(const Directory: string): string; + function GetUnitPathForDirectory(const Directory: string): string; + function IsEqual(SrcDefineTree: TDefineTree): boolean; + function LoadFromXMLConfig(XMLConfig: TXMLConfig; + const Path: string; Policy: TDefineTreeLoadPolicy; + const NewNamePrefix: string): boolean; + function SaveToXMLConfig(XMLConfig: TXMLConfig; + const Path: string; Policy: TDefineTreeSavePolicy): boolean; + procedure Add(ADefineTemplate: TDefineTemplate); + procedure AddChild(ParentTemplate, NewDefineTemplate: TDefineTemplate); + procedure AddFirst(ADefineTemplate: TDefineTemplate); + procedure Assign(SrcDefineTree: TDefineTree); + procedure Clear; + procedure ClearCache; + procedure ReadValue(const DirDef: TDirectoryDefines; + const PreValue, CurDefinePath: string; var NewValue: string); + procedure RemoveGlobals; + procedure RemoveMarked; + procedure RemoveNonAutoCreated; + procedure RemoveProjectSpecificAndParents; + procedure RemoveProjectSpecificOnly; + procedure RemoveRootDefineTemplateByName(const AName: string); + procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate; + const ChildName: string); + procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate); + procedure ReplaceRootSameName(const Name: string; + ADefineTemplate: TDefineTemplate); + procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate); procedure WriteDebugReport; end; @@ -1200,11 +1212,17 @@ begin inherited Create; FFirstDefineTemplate:=nil; FCache:=TAVLTree.Create(@CompareDirectoryDefines); + FMacroFunctions:=TKeyWordFunctionList.Create; + FMacroFunctions.AddExtended('Ext',nil,@MacroFuncExtractFileExt); + FMacroFunctions.AddExtended('PATH',nil,@MacroFuncExtractFilePath); + FMacroFunctions.AddExtended('NAME',nil,@MacroFuncExtractFileName); + FMacroFunctions.AddExtended('NAMEONLY',nil,@MacroFuncExtractFileNameOnly); end; destructor TDefineTree.Destroy; begin Clear; + FMacroFunctions.Free; FCache.Free; inherited Destroy; end; @@ -1230,6 +1248,42 @@ begin Result:=nil; end; +function TDefineTree.MacroFuncExtractFileExt(Data: Pointer): boolean; +var + FuncData: PReadFunctionData; +begin + FuncData:=PReadFunctionData(Data); + FuncData^.Result:=ExtractFileExt(FuncData^.Param); + Result:=true; +end; + +function TDefineTree.MacroFuncExtractFilePath(Data: Pointer): boolean; +var + FuncData: PReadFunctionData; +begin + FuncData:=PReadFunctionData(Data); + FuncData^.Result:=ExtractFilePath(FuncData^.Param); + Result:=true; +end; + +function TDefineTree.MacroFuncExtractFileName(Data: Pointer): boolean; +var + FuncData: PReadFunctionData; +begin + FuncData:=PReadFunctionData(Data); + FuncData^.Result:=ExtractFileName(FuncData^.Param); + Result:=true; +end; + +function TDefineTree.MacroFuncExtractFileNameOnly(Data: Pointer): boolean; +var + FuncData: PReadFunctionData; +begin + FuncData:=PReadFunctionData(Data); + FuncData^.Result:=ExtractFileNameOnly(FuncData^.Param); + Result:=true; +end; + procedure TDefineTree.RemoveMarked; var NewFirstNode: TDefineTemplate; begin @@ -1530,21 +1584,13 @@ var end; function ExecuteMacroFunction(const FuncName, Params: string): string; - var UpFuncName, Ext: string; + var + FuncData: TReadFunctionData; begin - UpFuncName:=UpperCaseStr(FuncName); - if UpFuncName='EXT' then begin - Result:=ExtractFileExt(Params); - end else if UpFuncName='PATH' then begin - Result:=ExtractFilePath(Params); - end else if UpFuncName='NAME' then begin - Result:=ExtractFileName(Params); - end else if UpFuncName='NAMEONLY' then begin - Result:=ExtractFileName(Params); - Ext:=ExtractFileExt(Result); - Result:=copy(Result,1,length(Result)-length(Ext)); - end else - Result:='<'+Format(ctsUnknownFunction,[FuncName])+'>'; + FuncData.Param:=Params; + FuncData.Result:=''; + FMacroFunctions.DoDataFunction(@FuncName[1],length(FuncName),@FuncData); + Result:=FuncData.Result; end; procedure GrowBuffer(MinSize: integer); @@ -1594,7 +1640,7 @@ var if MacroFuncNameLen>0 then begin MacroFuncName:=copy(CurValue,MacroStart+1,MacroFuncNameLen); // Macro function -> substitute macro parameter first - ReadValue(DirDef,copy(MacroStr,MacroFuncNameLen+2 + ReadValue(DirDef,copy(MacroStr,MacroNameEnd+1 ,MacroLen-MacroFuncNameLen-3),CurDefinePath,MacroParam); // execute the macro function MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam); diff --git a/components/codetools/keywordfunclists.pas b/components/codetools/keywordfunclists.pas index 0214cedfd4..918a6250df 100644 --- a/components/codetools/keywordfunclists.pas +++ b/components/codetools/keywordfunclists.pas @@ -39,17 +39,21 @@ uses type TKeyWordFunction = function: boolean of object; + TKeyWordDataFunction = function(Data: Pointer): boolean of object; - TKeyWordFunctionListItem = class - private + TKeyWordFunctionListItem = record IsLast: boolean; KeyWord: shortstring; DoIt: TKeyWordFunction; + DoDataFunction: TKeyWordDataFunction; end; + PKeyWordFunctionListItem = ^TKeyWordFunctionListItem; TKeyWordFunctionList = class private - FItems: TList; // list of TKeyWordFunctionListItem; + FItems: PKeyWordFunctionListItem; + FCount: integer; + FCapacity: integer; FSorted: boolean; FBucketStart: {$ifdef FPC}^{$else}array of {$endif}integer; FMaxHashIndex: integer; @@ -57,6 +61,7 @@ type function KeyWordToHashIndex(const ASource: string; AStart, ALen: integer): integer; function KeyWordToHashIndex(Identifier: PChar): integer; + function KeyWordToHashIndex(Start: PChar; Len: integer): integer; public DefaultKeyWordFunction: TKeyWordFunction; function DoIt(const AKeyWord: shortstring): boolean; @@ -66,8 +71,13 @@ type function DoItUppercase(const AnUpperSource: string; KeyWordStart, KeyWordLen: integer): boolean; function DoItCaseInsensitive(const AKeyWord: shortstring): boolean; + function DoDataFunction(Start: PChar; Len: integer; Data: pointer): boolean; procedure Clear; - procedure Add(const AKeyWord: shortstring; AFunction: TKeyWordFunction); + procedure Add(const AKeyWord: shortstring; + const AFunction: TKeyWordFunction); + procedure AddExtended(const AKeyWord: shortstring; + const AFunction: TKeyWordFunction; + const ADataFunction: TKeyWordDataFunction); procedure Sort; property Sorted: boolean read FSorted; procedure WriteDebugListing; @@ -146,7 +156,9 @@ end; constructor TKeyWordFunctionList.Create; begin inherited Create; - FItems:=TList.Create; // list of TKeyWordFunctionListItem; + FItems:=nil; + FCount:=0; + FCapacity:=0; FSorted:=true; FBucketStart:=nil; FMaxHashIndex:=-1; @@ -156,15 +168,17 @@ end; destructor TKeyWordFunctionList.Destroy; begin Clear; - FItems.Free; inherited Destroy; end; procedure TKeyWordFunctionList.Clear; -var i: integer; begin - for i:=0 to FItems.Count-1 do TKeyWordFunctionListItem(FItems[i]).Free; - FItems.Clear; + if FItems<>nil then begin + FreeMem(FItems); + FItems:=nil; + end; + FCount:=0; + FCapacity:=0; if FBucketStart<>nil then begin FreeMem(FBucketStart); FBucketStart:=nil; @@ -210,8 +224,23 @@ begin if Result>FMaxHashIndex then Result:=-1; end; +function TKeyWordFunctionList.KeyWordToHashIndex(Start: PChar; Len: integer + ): integer; +begin + Result:=0; + if Len>20 then Len:=20; + while (Len>0) do begin + inc(Result,CharToHash[Start^]); + dec(Len); + inc(Start); + end; + if Result>FMaxHashIndex then Result:=-1; +end; + function TKeyWordFunctionList.DoIt(const AKeyWord: shortstring): boolean; -var i: integer; +var + i: integer; + KeyWordFuncItem: PKeyWordFunctionListItem; begin if not FSorted then Sort; i:=KeyWordToHashIndex(AKeyWord); @@ -219,14 +248,15 @@ begin i:=FBucketStart[i]; if i>=0 then begin repeat - if (TKeyWordFunctionListItem(FItems[i]).KeyWord=AKeyWord) then begin - if Assigned(TKeyWordFunctionListItem(FItems[i]).DoIt) then - Result:=TKeyWordFunctionListItem(FItems[i]).DoIt() + KeyWordFuncItem:=@FItems[i]; + if (KeyWordFuncItem^.KeyWord=AKeyWord) then begin + if Assigned(KeyWordFuncItem^.DoIt) then + Result:=KeyWordFuncItem^.DoIt() else Result:=DefaultKeyWordFunction(); exit; end; - if (TKeyWordFunctionListItem(FItems[i])).IsLast then break; + if KeyWordFuncItem^.IsLast then break; inc(i); until false; end; @@ -238,7 +268,7 @@ function TKeyWordFunctionList.DoIt(const ASource: string; KeyWordStart, KeyWordLen: integer): boolean; // ! does not test if length(ASource) >= KeyWordStart+KeyWordLen -1 var i, KeyPos, WordPos: integer; - KeyWordFuncItem: TKeyWordFunctionListItem; + KeyWordFuncItem: PKeyWordFunctionListItem; begin if not FSorted then Sort; i:=KeyWordToHashIndex(ASource,KeyWordStart,KeyWordLen); @@ -247,25 +277,25 @@ begin if i>=0 then begin dec(KeyWordStart); repeat - KeyWordFuncItem:=TKeyWordFunctionListItem(FItems[i]); - if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin + KeyWordFuncItem:=@FItems[i]; + if length(KeyWordFuncItem^.KeyWord)=KeyWordLen then begin KeyPos:=KeyWordLen; WordPos:=KeyWordStart+KeyWordLen; while (KeyPos>=1) - and (KeyWordFuncItem.KeyWord[KeyPos]=UpChars[ASource[WordPos]]) do + and (KeyWordFuncItem^.KeyWord[KeyPos]=UpChars[ASource[WordPos]]) do begin dec(KeyPos); dec(WordPos); end; if KeyPos<1 then begin - if Assigned(KeyWordFuncItem.DoIt) then - Result:=KeyWordFuncItem.DoIt() + if Assigned(KeyWordFuncItem^.DoIt) then + Result:=KeyWordFuncItem^.DoIt() else Result:=DefaultKeyWordFunction(); exit; end; end; - if (KeyWordFuncItem.IsLast) then break; + if (KeyWordFuncItem^.IsLast) then break; inc(i); until false; end; @@ -276,7 +306,7 @@ end; function TKeyWordFunctionList.DoIt(Identifier: PChar): boolean; // checks var i, KeyPos, KeyWordLen: integer; - KeyWordFuncItem: TKeyWordFunctionListItem; + KeyWordFuncItem: PKeyWordFunctionListItem; IdentifierEnd, WordPos: PChar; begin if not FSorted then Sort; @@ -289,25 +319,25 @@ begin i:=FBucketStart[i]; if i>=0 then begin repeat - KeyWordFuncItem:=TKeyWordFunctionListItem(FItems[i]); - if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin + KeyWordFuncItem:=@FItems[i]; + if length(KeyWordFuncItem^.KeyWord)=KeyWordLen then begin KeyPos:=KeyWordLen; WordPos:=IdentifierEnd; while (KeyPos>=1) - and (KeyWordFuncItem.KeyWord[KeyPos]=UpChars[WordPos[0]]) do + and (KeyWordFuncItem^.KeyWord[KeyPos]=UpChars[WordPos[0]]) do begin dec(KeyPos); dec(WordPos); end; if KeyPos<1 then begin - if Assigned(KeyWordFuncItem.DoIt) then - Result:=KeyWordFuncItem.DoIt() + if Assigned(KeyWordFuncItem^.DoIt) then + Result:=KeyWordFuncItem^.DoIt() else Result:=DefaultKeyWordFunction(); exit; end; end; - if (KeyWordFuncItem.IsLast) then break; + if (KeyWordFuncItem^.IsLast) then break; inc(i); until false; end; @@ -320,7 +350,7 @@ function TKeyWordFunctionList.DoItUppercase(const AnUpperSource: string; KeyWordStart, KeyWordLen: integer): boolean; // ! does not test if length(AnUpperSource) >= KeyWordStart+KeyWordLen -1 var i, KeyPos, WordPos: integer; - KeyWordFuncItem: TKeyWordFunctionListItem; + KeyWordFuncItem: PKeyWordFunctionListItem; begin if not FSorted then Sort; i:=KeyWordToHashIndex(AnUpperSource,KeyWordStart,KeyWordLen); @@ -329,25 +359,25 @@ begin if i>=0 then begin dec(KeyWordStart); repeat - KeyWordFuncItem:=TKeyWordFunctionListItem(FItems[i]); - if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin + KeyWordFuncItem:=@FItems[i]; + if length(KeyWordFuncItem^.KeyWord)=KeyWordLen then begin KeyPos:=KeyWordLen; WordPos:=KeyWordStart+KeyWordLen; while (KeyPos>=1) - and (KeyWordFuncItem.KeyWord[KeyPos]=AnUpperSource[WordPos]) do + and (KeyWordFuncItem^.KeyWord[KeyPos]=AnUpperSource[WordPos]) do begin dec(KeyPos); dec(WordPos); end; if KeyPos<1 then begin - if Assigned(KeyWordFuncItem.DoIt) then - Result:=KeyWordFuncItem.DoIt() + if Assigned(KeyWordFuncItem^.DoIt) then + Result:=KeyWordFuncItem^.DoIt() else Result:=DefaultKeyWordFunction(); exit; end; end; - if (KeyWordFuncItem.IsLast) then break; + if (KeyWordFuncItem^.IsLast) then break; inc(i); until false; end; @@ -356,22 +386,34 @@ begin end; procedure TKeyWordFunctionList.Add(const AKeyWord: shortstring; - AFunction: TKeyWordFunction); -var NewKeyWordFunction: TKeyWordFunctionListItem; + const AFunction: TKeyWordFunction); +begin + AddExtended(AKeyWord,AFunction,nil); +end; + +procedure TKeyWordFunctionList.AddExtended(const AKeyWord: shortstring; + const AFunction: TKeyWordFunction; const ADataFunction: TKeyWordDataFunction + ); begin FSorted:=false; - NewKeyWordFunction:=TKeyWordFunctionListItem.Create; - with NewKeyWordFunction do begin + if FCount=FCapacity then begin + FCapacity:=FCapacity*2+10; + ReAllocMem(FItems,SizeOf(TKeyWordFunctionListItem)*FCapacity); + end; + FillChar(FItems[FCount],SizeOF(TKeyWordFunctionListItem),0); + with FItems[FCount] do begin KeyWord:=AKeyWord; DoIt:=AFunction; + DoDataFunction:=ADataFunction; end; - FItems.Add(NewKeyWordFunction); + inc(FCount); end; procedure TKeyWordFunctionList.Sort; // bucketsort var i, h, NewMaxHashIndex: integer; - UnsortedItems: {$ifdef fpc}^{$else}array of {$endif}pointer; + UnsortedItems: PKeyWordFunctionListItem; + Size: Integer; begin if FSorted then exit; if FBucketStart<>nil then begin @@ -381,8 +423,8 @@ begin // find maximum hash index FMaxHashIndex:=99999; NewMaxHashIndex:=0; - for i:=0 to FItems.Count-1 do begin - h:=KeyWordToHashIndex(TKeyWordFunctionListItem(FItems[i]).KeyWord); + for i:=0 to FCount-1 do begin + h:=KeyWordToHashIndex(FItems[i].KeyWord); if h>NewMaxHashIndex then NewMaxHashIndex:=h; end; FMaxHashIndex:=NewMaxHashIndex; @@ -390,8 +432,8 @@ begin GetMem(FBucketStart,(FMaxHashIndex+1) * SizeOf(integer)); // compute every hash value count for i:=0 to FMaxHashIndex do FBucketStart[i]:=0; - for i:=0 to FItems.Count-1 do begin - h:=KeyWordToHashIndex(TKeyWordFunctionListItem(FItems[i]).KeyWord); + for i:=0 to FCount-1 do begin + h:=KeyWordToHashIndex(FItems[i].KeyWord); if h>=0 then inc(FBucketStart[h]); end; // change hash-count-index to bucket-end-index @@ -404,27 +446,30 @@ begin FBucketStart[i]:=h; end; inc(FBucketStart[FMaxHashIndex],h); - // copy all items - GetMem(UnsortedItems,sizeof(pointer)*FItems.Count); - for i:=0 to FItems.Count-1 do - UnsortedItems[i]:=FItems[i]; + // copy all items (just the data, not the string contents) + Size:=sizeof(TKeyWordFunctionListItem)*FCount; + GetMem(UnsortedItems,Size); + Move(FItems^,UnsortedItems^,Size); // copy unsorted items to Items back and do the bucket sort - for i:=FItems.Count-1 downto 0 do begin - h:=KeyWordToHashIndex(TKeyWordFunctionListItem(UnsortedItems[i]).KeyWord); + for i:=FCount-1 downto 0 do begin + h:=KeyWordToHashIndex(UnsortedItems[i].KeyWord); if h>=0 then begin dec(FBucketStart[h]); - FItems[FBucketStart[h]]:=UnsortedItems[i]; + // copy item back (just the data, not the string contents) + Move(UnsortedItems[i],FItems[FBucketStart[h]], + SizeOf(TKeyWordFunctionListItem)); end; end; + // free UnsortedItems + FreeMem(UnsortedItems); // set IsLast - if FItems.Count>0 then begin + if FCount>0 then begin for i:=1 to FMaxHashIndex do if FBucketStart[i]>0 then - TKeyWordFunctionListItem(FItems[FBucketStart[i]-1]).IsLast:=true; - TKeyWordFunctionListItem(FItems[FItems.Count-1]).IsLast:=true; + FItems[FBucketStart[i]-1].IsLast:=true; + FItems[FCount-1].IsLast:=true; end; // tidy up - FreeMem(UnsortedItems); FSorted:=true; end; @@ -433,11 +478,11 @@ var i: integer; begin Sort; writeln('[TKeyWordFunctionList.WriteDebugListing]'); - writeln(' ItemsCount=',FItems.Count,' MaxHash=',FMaxHashIndex + writeln(' ItemsCount=',FCount,' MaxHash=',FMaxHashIndex ,' Sorted=',FSorted); - for i:=0 to FItems.Count-1 do begin + for i:=0 to FCount-1 do begin write(' ',i,':'); - with TKeyWordFunctionListItem(FItems[i]) do begin + with FItems[i] do begin write(' "',KeyWord,'"'); write(' Hash=',KeyWordToHashIndex(KeyWord)); write(' IsLast=',IsLast); @@ -473,16 +518,55 @@ begin i:=FBucketStart[i]; if i>=0 then begin repeat - if AnsiCompareText(TKeyWordFunctionListItem(FItems[i]).KeyWord, - AKeyWord)=0 + if AnsiCompareText(FItems[i].KeyWord,AKeyWord)=0 then begin - if Assigned(TKeyWordFunctionListItem(FItems[i]).DoIt) then - Result:=TKeyWordFunctionListItem(FItems[i]).DoIt() + if Assigned(FItems[i].DoIt) then + Result:=FItems[i].DoIt() else Result:=DefaultKeyWordFunction(); exit; end; - if (TKeyWordFunctionListItem(FItems[i])).IsLast then break; + if FItems[i].IsLast then break; + inc(i); + until false; + end; + end; + Result:=DefaultKeyWordFunction(); +end; + +function TKeyWordFunctionList.DoDataFunction(Start: PChar; Len: integer; + Data: pointer): boolean; +var i, KeyPos: integer; + KeyWordFuncItem: PKeyWordFunctionListItem; + WordPos: PChar; + KeyWordEnd: PChar; +begin + if not FSorted then Sort; + i:=KeyWordToHashIndex(Start,Len); + if i>=0 then begin + i:=FBucketStart[i]; + if i>=0 then begin + KeyWordEnd:=PChar(integer(Start)+Len); + repeat + KeyWordFuncItem:=@FItems[i]; + if length(KeyWordFuncItem^.KeyWord)=Len then begin + KeyPos:=Len; + WordPos:=KeyWordEnd; + while (KeyPos>=1) + and (KeyWordFuncItem^.KeyWord[KeyPos]=UpChars[WordPos[0]]) do + begin + dec(KeyPos); + dec(WordPos); + end; + if KeyPos<1 then begin + if Assigned(KeyWordFuncItem^.DoDataFunction) then + Result:=KeyWordFuncItem^.DoDataFunction(Data) + else + Result:=DefaultKeyWordFunction(); + exit; + end; + end; + if (KeyWordFuncItem^.IsLast) then break; inc(i); until false; end; @@ -512,6 +596,7 @@ begin UpWords[w]:=ord(UpChars[chr(w and $ff)])+(ord(UpChars[chr(w shr 8)]) shl 8); KeyWordLists:=TList.Create; + IsKeyWordMethodSpecifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordMethodSpecifier); with IsKeyWordMethodSpecifier do begin @@ -530,6 +615,7 @@ begin Add('DEPRECATED' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('PLATFORM' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordProcedureSpecifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordProcedureSpecifier); with IsKeyWordProcedureSpecifier do begin @@ -553,6 +639,7 @@ begin Add('IOCHECK' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('[' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordProcedureTypeSpecifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordProcedureTypeSpecifier); with IsKeyWordProcedureTypeSpecifier do begin @@ -566,6 +653,7 @@ begin Add('DEPRECATED' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('PLATFORM' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordProcedureBracketSpecifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordProcedureBracketSpecifier); with IsKeyWordProcedureBracketSpecifier do begin @@ -577,6 +665,7 @@ begin Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue); Add('IOCHECK' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordSection:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordSection); with IsKeyWordSection do begin @@ -589,6 +678,7 @@ begin Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordInConstAllowed:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordInConstAllowed); with IsKeyWordInConstAllowed do begin @@ -606,6 +696,7 @@ begin Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsKeyWord:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsKeyWord); with WordIsKeyWord do begin @@ -673,6 +764,7 @@ begin Add('WITH',{$ifdef FPC}@{$endif}AllwaysTrue); Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsDelphiKeyWord:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsDelphiKeyWord); with WordIsDelphiKeyWord do begin @@ -740,6 +832,7 @@ begin Add('WITH',{$ifdef FPC}@{$endif}AllwaysTrue); Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); end; + IsKeyWordBuiltInFunc:=TKeyWordFunctionList.Create; KeyWordLists.Add(IsKeyWordBuiltInFunc); with IsKeyWordBuiltInFunc do begin @@ -750,6 +843,7 @@ begin Add('SUCC',{$ifdef FPC}@{$endif}AllwaysTrue); Add('LENGTH',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsTermOperator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsTermOperator); with WordIsTermOperator do begin @@ -767,6 +861,7 @@ begin Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue); Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsPropertySpecifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsPropertySpecifier); with WordIsPropertySpecifier do begin @@ -778,6 +873,7 @@ begin Add('DEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('NODEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsBlockKeyWord:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsBlockKeyWord); with WordIsBlockKeyWord do begin @@ -796,6 +892,7 @@ begin Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue); Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue); end; + EndKeyWordFuncList:=TKeyWordFunctionList.Create; KeyWordLists.Add(EndKeyWordFuncList); with EndKeyWordFuncList do begin @@ -805,6 +902,7 @@ begin Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue); Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue); end; + PackedTypesKeyWordFuncList:=TKeyWordFunctionList.Create; KeyWordLists.Add(PackedTypesKeyWordFuncList); with PackedTypesKeyWordFuncList do begin @@ -815,6 +913,7 @@ begin Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue); Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue); end; + BlockStatementStartKeyWordFuncList:=TKeyWordFunctionList.Create; KeyWordLists.Add(BlockStatementStartKeyWordFuncList); with BlockStatementStartKeyWordFuncList do begin @@ -824,6 +923,7 @@ begin Add('ASM' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('CASE' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + UnexpectedKeyWordInBeginBlock:=TKeyWordFunctionList.Create; KeyWordLists.Add(UnexpectedKeyWordInBeginBlock); with UnexpectedKeyWordInBeginBlock do begin @@ -848,6 +948,7 @@ begin Add('VAR',{$ifdef FPC}@{$endif}AllwaysTrue); Add('THREADVAR',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsLogicalBlockStart:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsLogicalBlockStart); with WordIsLogicalBlockStart do begin @@ -880,6 +981,7 @@ begin Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsBinaryOperator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsBinaryOperator); with WordIsBinaryOperator do begin @@ -904,12 +1006,14 @@ begin Add('IS' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('AS' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsLvl1Operator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsLvl1Operator); with WordIsLvl1Operator do begin Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue); Add('@' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsLvl2Operator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsLvl2Operator); with WordIsLvl2Operator do begin @@ -922,6 +1026,7 @@ begin Add('SHR',{$ifdef FPC}@{$endif}AllwaysTrue); Add('AS' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsLvl3Operator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsLvl3Operator); with WordIsLvl3Operator do begin @@ -930,6 +1035,7 @@ begin Add('OR' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsLvl4Operator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsLvl4Operator); with WordIsLvl4Operator do begin @@ -942,6 +1048,7 @@ begin Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue); Add('IS',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsBooleanOperator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsBooleanOperator); with WordIsBooleanOperator do begin @@ -954,6 +1061,7 @@ begin Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue); Add('IS',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsOrdNumberOperator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsOrdNumberOperator); with WordIsOrdNumberOperator do begin @@ -965,6 +1073,7 @@ begin Add('DIV',{$ifdef FPC}@{$endif}AllwaysTrue); Add('MOD',{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsNumberOperator:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsNumberOperator); with WordIsNumberOperator do begin @@ -972,6 +1081,7 @@ begin Add('-' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('*' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsPredefinedFPCIdentifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsPredefinedFPCIdentifier); with WordIsPredefinedFPCIdentifier do begin @@ -1009,6 +1119,7 @@ begin Add('LONGWORD' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('COPY' ,{$ifdef FPC}@{$endif}AllwaysTrue); end; + WordIsPredefinedDelphiIdentifier:=TKeyWordFunctionList.Create; KeyWordLists.Add(WordIsPredefinedDelphiIdentifier); with WordIsPredefinedDelphiIdentifier do begin diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index c07657e3f0..c34a47dcb6 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -93,6 +93,7 @@ type IgnoreErrors: boolean): TModalResult; function CheckIfPackageNeedsCompilation(APackage: TLazPackage): TModalResult; procedure UpdateCodeToolsDefinesForPackage(APackage: TLazPackage); + function MacroFunctionPkgSrcPath(Data: Pointer): boolean; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; @@ -793,14 +794,37 @@ begin 'Output directory','',APackage.GetOutputDirectory,da_Directory); CompiledSrcPathDefTempl:=TDefineTemplate.Create('CompiledSrcPath', 'CompiledSrcPath addition',CompiledSrcPathMacroName, - '$PkgUnitPath('+APackage.IDAsString+');$('+CompiledSrcPathMacroName+')', + '$PkgSrcPath('+APackage.IDAsString+');$('+CompiledSrcPathMacroName+')', da_Define); OutPutDirDefTempl.AddChild(CompiledSrcPathDefTempl); + PkgDefTempl.AddChild(OutPutDirDefTempl); + CodeToolBoss.DefineTree.ClearCache; end else begin - + + // ToDo: update Package ID if needed + end; end; +function TPkgManager.MacroFunctionPkgSrcPath(Data: Pointer): boolean; +var + FuncData: PReadFunctionData; + PkgID: TLazPackageID; + APackage: TLazPackage; +begin + FuncData:=PReadFunctionData(Data); + PkgID:=TLazPackageID.Create; + Result:=false; + if PkgID.StringToID(FuncData^.Param) then begin + APackage:=PackageGraph.FindPackageWithID(PkgID); + if APackage<>nil then begin + FuncData^.Result:=APackage.SourceDirectories.CreateSearchPathFromAllFiles; + Result:=true; + end; + end; + PkgID.Free; +end; + constructor TPkgManager.Create(TheOwner: TComponent); begin inherited Create(TheOwner); @@ -826,6 +850,9 @@ begin PackageEditors.OnFreeEditor:=@OnPackageEditorFreeEditor; PackageEditors.OnSavePackage:=@OnPackageEditorSavePackage; PackageEditors.OnCompilePackage:=@OnPackageEditorCompilePackage; + + CodeToolBoss.DefineTree.MacroFunctions.AddExtended( + 'PKGSRCPATH',nil,@MacroFunctionPkgSrcPath); Application.AddOnIdleHandler(@OnApplicationIdle); end;