implemented macro functions for define templates

git-svn-id: trunk@4076 -

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);
+    FuncData.Param:=Params;
-    if UpFuncName='EXT' then begin
+    FuncData.Result:='';
-      Result:=ExtractFileExt(Params);
+    FMacroFunctions.DoDataFunction(@FuncName[1],length(FuncName),@FuncData);
-    end else if UpFuncName='PATH' then begin
+    Result:=FuncData.Result;
-      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])+'>';
   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);

components/codetools/keywordfunclists.pas

@@ -39,17 +39,21 @@ uses
 
 type
   TKeyWordFunction = function: boolean of object;
+  TKeyWordDataFunction = function(Data: Pointer): boolean of object;
 
-  TKeyWordFunctionListItem = class
+  TKeyWordFunctionListItem = record
-  private
     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;
+  if FItems<>nil then begin
-  FItems.Clear;
+    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
+        KeyWordFuncItem:=@FItems[i];
-          if Assigned(TKeyWordFunctionListItem(FItems[i]).DoIt) then
+        if (KeyWordFuncItem^.KeyWord=AKeyWord) then begin
-            Result:=TKeyWordFunctionListItem(FItems[i]).DoIt()
+          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]);
+        KeyWordFuncItem:=@FItems[i];
-        if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin
+        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
+            if Assigned(KeyWordFuncItem^.DoIt) then
-              Result:=KeyWordFuncItem.DoIt()
+              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]);
+        KeyWordFuncItem:=@FItems[i];
-        if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin
+        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
+            if Assigned(KeyWordFuncItem^.DoIt) then
-              Result:=KeyWordFuncItem.DoIt()
+              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]);
+        KeyWordFuncItem:=@FItems[i];
-        if length(KeyWordFuncItem.KeyWord)=KeyWordLen then begin
+        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
+            if Assigned(KeyWordFuncItem^.DoIt) then
-              Result:=KeyWordFuncItem.DoIt()
+              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);
+  const AFunction: TKeyWordFunction);
-var NewKeyWordFunction: TKeyWordFunctionListItem;
+begin
+  AddExtended(AKeyWord,AFunction,nil);
+end;
+
+procedure TKeyWordFunctionList.AddExtended(const AKeyWord: shortstring;
+  const AFunction: TKeyWordFunction; const ADataFunction: TKeyWordDataFunction
+    );
 begin
   FSorted:=false;
-  NewKeyWordFunction:=TKeyWordFunctionListItem.Create;
+  if FCount=FCapacity then begin
-  with NewKeyWordFunction do 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
+  for i:=0 to FCount-1 do begin
-    h:=KeyWordToHashIndex(TKeyWordFunctionListItem(FItems[i]).KeyWord);
+    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
+  for i:=0 to FCount-1 do begin
-    h:=KeyWordToHashIndex(TKeyWordFunctionListItem(FItems[i]).KeyWord);
+    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
+  // copy all items (just the data, not the string contents)
-  GetMem(UnsortedItems,sizeof(pointer)*FItems.Count);
+  Size:=sizeof(TKeyWordFunctionListItem)*FCount;
-  for i:=0 to FItems.Count-1 do
+  GetMem(UnsortedItems,Size);
-    UnsortedItems[i]:=FItems[i];
+  Move(FItems^,UnsortedItems^,Size);
   // copy unsorted items to Items back and do the bucket sort
-  for i:=FItems.Count-1 downto 0 do begin
+  for i:=FCount-1 downto 0 do begin
-    h:=KeyWordToHashIndex(TKeyWordFunctionListItem(UnsortedItems[i]).KeyWord);
+    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;
+        FItems[FBucketStart[i]-1].IsLast:=true;
-    TKeyWordFunctionListItem(FItems[FItems.Count-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,
+        if AnsiCompareText(FItems[i].KeyWord,AKeyWord)=0
-          AKeyWord)=0
         then begin
-          if Assigned(TKeyWordFunctionListItem(FItems[i]).DoIt) then
+          if Assigned(FItems[i].DoIt) then
-            Result:=TKeyWordFunctionListItem(FItems[i]).DoIt()
+            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

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;