Browse Source

fcl-css: TCSSParser allows to override css classes

mattias 1 year ago
parent
commit
fadb324f7c
2 changed files with 183 additions and 80 deletions
  1. 116 80
      packages/fcl-css/src/fpcssparser.pp
  2. 67 0
      packages/fcl-css/src/fpcsstree.pp

+ 116 - 80
packages/fcl-css/src/fpcssparser.pp

@@ -45,59 +45,77 @@ Type
     FPeekTokenString : TCSSString;
     FPeekTokenString : TCSSString;
     FFreeScanner : Boolean;
     FFreeScanner : Boolean;
     FRuleLevel : Integer;
     FRuleLevel : Integer;
-    function CreateElement(aClass: TCSSElementClass): TCSSElement;
-    class function GetAppendElement(aList: TCSSListElement): TCSSElement;
     function GetAtEOF: Boolean;
     function GetAtEOF: Boolean;
     function GetCurSource: TCSSString;
     function GetCurSource: TCSSString;
     Function GetCurLine : Integer;
     Function GetCurLine : Integer;
     Function GetCurPos : Integer;
     Function GetCurPos : Integer;
   protected
   protected
-    Procedure DoWarn(const Msg : TCSSString);
+    function CreateElement(aClass: TCSSElementClass): TCSSElement; virtual;
+    class function GetAppendElement(aList: TCSSListElement): TCSSElement;
+    Procedure DoWarn(const Msg : TCSSString); virtual;
     Procedure DoWarn(const Fmt : TCSSString; const Args : Array of const);
     Procedure DoWarn(const Fmt : TCSSString; const Args : Array of const);
     Procedure DoWarnExpectedButGot(const Expected: string);
     Procedure DoWarnExpectedButGot(const Expected: string);
-    Procedure DoError(const Msg : TCSSString);
+    Procedure DoError(const Msg : TCSSString); virtual;
     Procedure DoError(const Fmt : TCSSString; const Args : Array of const);
     Procedure DoError(const Fmt : TCSSString; const Args : Array of const);
     Procedure DoErrorExpectedButGot(const Expected: string);
     Procedure DoErrorExpectedButGot(const Expected: string);
-    Procedure Consume(aToken : TCSSToken);
+    Procedure Consume(aToken : TCSSToken); virtual;
     Procedure SkipWhiteSpace;
     Procedure SkipWhiteSpace;
-    function ParseComponentValueList(AllowRules: Boolean=True): TCSSElement;
-    function ParseComponentValue: TCSSElement;
-    function ParseExpression: TCSSElement;
-    function ParseRule: TCSSElement;
-    function ParseAtUnknownRule: TCSSElement;
-    function ParseAtMediaRule: TCSSAtRuleElement;
-    function ParseAtSimpleRule: TCSSAtRuleElement;
-    function ParseMediaCondition: TCSSElement;
-    function ParseRuleList(aStopOn : TCSStoken = ctkEOF): TCSSElement;
-    function ParseSelector: TCSSElement;
-    function ParseAttributeSelector: TCSSElement;
+    function ParseComponentValueList(AllowRules: Boolean=True): TCSSElement; virtual;
+    function ParseComponentValue: TCSSElement; virtual;
+    function ParseExpression: TCSSElement; virtual;
+    function ParseRule: TCSSElement; virtual;
+    function ParseAtUnknownRule: TCSSElement; virtual;
+    function ParseAtMediaRule: TCSSAtRuleElement; virtual;
+    function ParseAtSimpleRule: TCSSAtRuleElement; virtual;
+    function ParseMediaCondition: TCSSElement; virtual;
+    function ParseRuleList(aStopOn : TCSStoken = ctkEOF): TCSSElement; virtual;
+    function ParseSelector: TCSSElement; virtual;
+    function ParseAttributeSelector: TCSSElement; virtual;
     function ParseWQName: TCSSElement;
     function ParseWQName: TCSSElement;
-    function ParseDeclaration(aIsAt : Boolean = false): TCSSDeclarationElement;
-    function ParseCall(aName: TCSSString): TCSSElement;
-    procedure ParseSelectorCommaList(aCall: TCSSCallElement);
-    procedure ParseRelationalSelectorCommaList(aCall: TCSSCallElement);
-    procedure ParseNthChildParams(aCall: TCSSCallElement);
-    function ParseUnary: TCSSElement;
-    function ParseUnit: TCSSUnits;
-    function ParseIdentifier : TCSSIdentifierElement;
-    function ParseHashIdentifier : TCSSHashIdentifierElement;
-    function ParseClassName : TCSSClassNameElement;
-    function ParseParenthesis: TCSSElement;
-    function ParsePseudo: TCSSElement;
-    Function ParseRuleBody(aRule: TCSSRuleElement; aIsAt : Boolean = False) : integer;
-    function ParseInteger: TCSSElement;
-    function ParseFloat: TCSSElement;
-    function ParseString: TCSSElement;
-    Function ParseUnicodeRange : TCSSElement;
-    function ParseArray(aPrefix: TCSSElement): TCSSElement;
-    function ParseURL: TCSSElement;
-    function ParseInvalidToken: TCSSElement;
+    function ParseDeclaration(aIsAt : Boolean = false): TCSSDeclarationElement; virtual;
+    function ParseCall(aName: TCSSString): TCSSElement; virtual;
+    procedure ParseSelectorCommaList(aCall: TCSSCallElement); virtual;
+    procedure ParseRelationalSelectorCommaList(aCall: TCSSCallElement); virtual;
+    procedure ParseNthChildParams(aCall: TCSSCallElement); virtual;
+    function ParseUnary: TCSSElement; virtual;
+    function ParseUnit: TCSSUnits; virtual;
+    function ParseIdentifier : TCSSIdentifierElement; virtual;
+    function ParseHashIdentifier : TCSSHashIdentifierElement; virtual;
+    function ParseClassName : TCSSClassNameElement; virtual;
+    function ParseParenthesis: TCSSElement; virtual;
+    function ParsePseudo: TCSSElement; virtual;
+    Function ParseRuleBody(aRule: TCSSRuleElement; aIsAt : Boolean = False) : integer; virtual;
+    function ParseInteger: TCSSElement; virtual;
+    function ParseFloat: TCSSElement; virtual;
+    function ParseString: TCSSElement; virtual;
+    Function ParseUnicodeRange : TCSSElement; virtual;
+    function ParseArray(aPrefix: TCSSElement): TCSSElement; virtual;
+    function ParseURL: TCSSElement; virtual;
+    function ParseInvalidToken: TCSSElement; virtual;
     Property CurrentSource : TCSSString Read GetCurSource;
     Property CurrentSource : TCSSString Read GetCurSource;
     Property CurrentLine : Integer Read GetCurLine;
     Property CurrentLine : Integer Read GetCurLine;
     Property CurrentPos : Integer Read GetCurPos;
     Property CurrentPos : Integer Read GetCurPos;
   Public
   Public
-    Constructor Create(AInput: TStream; ExtraScannerOptions : TCSSScannerOptions = []);
-    Constructor Create(AScanner : TCSSScanner); virtual;
+    CSSArrayElementClass: TCSSArrayElementClass;
+    CSSAtRuleElementClass: TCSSAtRuleElementClass;
+    CSSBinaryElementClass: TCSSBinaryElementClass;
+    CSSCallElementClass: TCSSCallElementClass;
+    CSSClassNameElementClass: TCSSClassNameElementClass;
+    CSSCompoundElementClass: TCSSCompoundElementClass;
+    CSSDeclarationElementClass: TCSSDeclarationElementClass;
+    CSSFloatElementClass: TCSSFloatElementClass;
+    CSSHashIdentifierElementClass: TCSSHashIdentifierElementClass;
+    CSSIdentifierElementClass: TCSSIdentifierElementClass;
+    CSSIntegerElementClass: TCSSIntegerElementClass;
+    CSSListElementClass: TCSSListElementClass;
+    CSSPseudoClassElementClass: TCSSPseudoClassElementClass;
+    CSSRuleElementClass: TCSSRuleElementClass;
+    CSSStringElementClass: TCSSStringElementClass;
+    CSSUnaryElementClass: TCSSUnaryElementClass;
+    CSSUnicodeRangeElementClass: TCSSUnicodeRangeElementClass;
+    CSSURLElementClass: TCSSURLElementClass;
+    Constructor Create(AInput: TStream; ExtraScannerOptions : TCSSScannerOptions = []); overload;
+    Constructor Create(AScanner : TCSSScanner); virtual; overload;
     Destructor Destroy; override;
     Destructor Destroy; override;
     Function Parse : TCSSElement;
     Function Parse : TCSSElement;
     Function ParseInline : TCSSElement;
     Function ParseInline : TCSSElement;
@@ -280,6 +298,24 @@ begin
   FPeekToken:=ctkUNKNOWN;
   FPeekToken:=ctkUNKNOWN;
   FPeekTokenString:='';
   FPeekTokenString:='';
   FScanner:=aScanner;
   FScanner:=aScanner;
+  CSSArrayElementClass:=TCSSArrayElement;
+  CSSAtRuleElementClass:=TCSSAtRuleElement;
+  CSSBinaryElementClass:=TCSSBinaryElement;
+  CSSCallElementClass:=TCSSCallElement;
+  CSSClassNameElementClass:=TCSSClassNameElement;
+  CSSCompoundElementClass:=TCSSCompoundElement;
+  CSSDeclarationElementClass:=TCSSDeclarationElement;
+  CSSFloatElementClass:=TCSSFloatElement;
+  CSSHashIdentifierElementClass:=TCSSHashIdentifierElement;
+  CSSIdentifierElementClass:=TCSSIdentifierElement;
+  CSSIntegerElementClass:=TCSSIntegerElement;
+  CSSListElementClass:=TCSSListElement;
+  CSSPseudoClassElementClass:=TCSSPseudoClassElement;
+  CSSRuleElementClass:=TCSSRuleElement;
+  CSSStringElementClass:=TCSSStringElement;
+  CSSUnaryElementClass:=TCSSUnaryElement;
+  CSSUnicodeRangeElementClass:=TCSSUnicodeRangeElement;
+  CSSURLElementClass:=TCSSURLElement;
 end;
 end;
 
 
 destructor TCSSParser.Destroy;
 destructor TCSSParser.Destroy;
@@ -322,12 +358,12 @@ begin
   Writeln('Parse @ rule');
   Writeln('Parse @ rule');
 {$endif}
 {$endif}
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
-  aRule:=TCSSAtRuleElement(CreateElement(TCSSAtRuleElement));
+  aRule:=TCSSAtRuleElement(CreateElement(CSSAtRuleElementClass));
   TCSSAtRuleElement(aRule).AtKeyWord:=CurrentTokenString;
   TCSSAtRuleElement(aRule).AtKeyWord:=CurrentTokenString;
   GetNextToken;
   GetNextToken;
   aList:=nil;
   aList:=nil;
   try
   try
-    aList:=TCSSListElement(CreateElement(TCSSListElement));
+    aList:=TCSSListElement(CreateElement(CSSListElementClass));
     While Not (CurrentToken in Term) do
     While Not (CurrentToken in Term) do
       begin
       begin
       aSel:=ParseComponentValue;
       aSel:=ParseComponentValue;
@@ -336,7 +372,7 @@ begin
         begin
         begin
         Consume(ctkCOMMA);
         Consume(ctkCOMMA);
         aRule.AddSelector(GetAppendElement(aList));
         aRule.AddSelector(GetAppendElement(aList));
-        aList:=TCSSListElement(CreateElement(TCSSListElement));
+        aList:=TCSSListElement(CreateElement(CSSListElementClass));
         end;
         end;
       end;
       end;
     aRule.AddSelector(GetAppendElement(aList));
     aRule.AddSelector(GetAppendElement(aList));
@@ -375,12 +411,12 @@ begin
   Writeln('Parse @media rule');
   Writeln('Parse @media rule');
 {$endif}
 {$endif}
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
-  aRule:=TCSSAtRuleElement(CreateElement(TCSSAtRuleElement));
+  aRule:=TCSSAtRuleElement(CreateElement(CSSAtRuleElementClass));
   aRule.AtKeyWord:=CurrentTokenString;
   aRule.AtKeyWord:=CurrentTokenString;
   GetNextToken;
   GetNextToken;
   aList:=nil;
   aList:=nil;
   try
   try
-    aList:=TCSSListElement(CreateElement(TCSSListElement));
+    aList:=TCSSListElement(CreateElement(CSSListElementClass));
     While Not (CurrentToken in Term) do
     While Not (CurrentToken in Term) do
       begin
       begin
       aToken:=CurrentToken;
       aToken:=CurrentToken;
@@ -397,7 +433,7 @@ begin
         begin
         begin
         Consume(ctkCOMMA);
         Consume(ctkCOMMA);
         aRule.AddSelector(GetAppendElement(aList));
         aRule.AddSelector(GetAppendElement(aList));
-        aList:=TCSSListElement(CreateElement(TCSSListElement));
+        aList:=TCSSListElement(CreateElement(CSSListElementClass));
         end;
         end;
       end;
       end;
     aRule.AddSelector(GetAppendElement(aList));
     aRule.AddSelector(GetAppendElement(aList));
@@ -431,7 +467,7 @@ begin
   aAt:=Format(' Level %d at (%d:%d)',[FRuleLevel,CurrentLine,CurrentPos]);
   aAt:=Format(' Level %d at (%d:%d)',[FRuleLevel,CurrentLine,CurrentPos]);
   Writeln('Parse @font-face rule');
   Writeln('Parse @font-face rule');
 {$endif}
 {$endif}
-  aRule:=TCSSAtRuleElement(CreateElement(TCSSAtRuleElement));
+  aRule:=TCSSAtRuleElement(CreateElement(CSSAtRuleElementClass));
   try
   try
     aRule.AtKeyWord:=CurrentTokenString;
     aRule.AtKeyWord:=CurrentTokenString;
     GetNextToken;
     GetNextToken;
@@ -497,7 +533,7 @@ begin
       if TCSSIdentifierElement(El).Value='not' then
       if TCSSIdentifierElement(El).Value='not' then
         begin
         begin
         // (not(mediacondition))
         // (not(mediacondition))
-        List:=TCSSListElement(CreateElement(TCSSListElement));
+        List:=TCSSListElement(CreateElement(CSSListElementClass));
         List.AddChild(El);
         List.AddChild(El);
         El:=nil;
         El:=nil;
         List.AddChild(ParseMediaCondition());
         List.AddChild(ParseMediaCondition());
@@ -508,7 +544,7 @@ begin
       else if CurrentToken=ctkCOLON then
       else if CurrentToken=ctkCOLON then
         begin
         begin
         // (mediaproperty: value)
         // (mediaproperty: value)
-        Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+        Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
         Bin.Left:=El;
         Bin.Left:=El;
         El:=nil;
         El:=nil;
         Consume(ctkCOLON);
         Consume(ctkCOLON);
@@ -545,7 +581,7 @@ begin
       ctkEQUALS,
       ctkEQUALS,
       ctkGE,ctkGT,ctkLE,ctkLT:
       ctkGE,ctkGT,ctkLE,ctkLT:
         begin
         begin
-        Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+        Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
         Bin.Left:=El;
         Bin.Left:=El;
         Bin.Operation:=TokenToBinaryOperation(aToken);
         Bin.Operation:=TokenToBinaryOperation(aToken);
         GetNextToken;
         GetNextToken;
@@ -612,7 +648,7 @@ Var
   Terms : TCSSTokens;
   Terms : TCSSTokens;
 begin
 begin
   Terms:=[ctkEOF,aStopOn];
   Terms:=[ctkEOF,aStopOn];
-  aList:=TCSSCompoundElement(CreateElement(TCSSCompoundElement));
+  aList:=TCSSCompoundElement(CreateElement(CSSCompoundElementClass));
   Try
   Try
     While not (CurrentToken in Terms) do
     While not (CurrentToken in Terms) do
       begin
       begin
@@ -642,7 +678,7 @@ var
   aRule: TCSSRuleElement;
   aRule: TCSSRuleElement;
 begin
 begin
   GetNextToken;
   GetNextToken;
-  aRule:=TCSSRuleElement(CreateElement(TCSSRuleElement));
+  aRule:=TCSSRuleElement(CreateElement(CSSRuleElementClass));
   try
   try
     ParseRuleBody(aRule);
     ParseRuleBody(aRule);
     Result:=aRule;
     Result:=aRule;
@@ -725,7 +761,7 @@ Var
 
 
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
-  Result:=TCSSIdentifierElement(CreateElement(TCSSIdentifierElement));
+  Result:=TCSSIdentifierElement(CreateElement(CSSIdentifierElementClass));
   Result.Value:=aValue;
   Result.Value:=aValue;
   GetNextToken;
   GetNextToken;
 end;
 end;
@@ -738,7 +774,7 @@ Var
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
   system.delete(aValue,1,1);
   system.delete(aValue,1,1);
-  Result:=TCSSHashIdentifierElement(CreateElement(TCSSHashIdentifierElement));
+  Result:=TCSSHashIdentifierElement(CreateElement(CSSHashIdentifierElementClass));
   Result.Value:=aValue;
   Result.Value:=aValue;
   GetNextToken;
   GetNextToken;
 end;
 end;
@@ -751,7 +787,7 @@ Var
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
   system.delete(aValue,1,1);
   system.delete(aValue,1,1);
-  Result:=TCSSClassNameElement(CreateElement(TCSSClassNameElement));
+  Result:=TCSSClassNameElement(CreateElement(CSSClassNameElementClass));
   Result.Value:=aValue;
   Result.Value:=aValue;
   GetNextToken;
   GetNextToken;
 end;
 end;
@@ -764,7 +800,7 @@ Var
 
 
 begin
 begin
   aValue:=StrToInt(CurrentTokenString);
   aValue:=StrToInt(CurrentTokenString);
-  aInt:=TCSSIntegerElement(CreateElement(TCSSIntegerElement));
+  aInt:=TCSSIntegerElement(CreateElement(CSSIntegerElementClass));
   try
   try
     aInt.Value:=aValue;
     aInt.Value:=aValue;
     Consume(ctkINTEGER);
     Consume(ctkINTEGER);
@@ -786,7 +822,7 @@ begin
   Val(CurrentTokenString,aValue,aCode);
   Val(CurrentTokenString,aValue,aCode);
   if aCode<>0 then
   if aCode<>0 then
     DoError(SErrInvalidFloat,[CurrentTokenString]);
     DoError(SErrInvalidFloat,[CurrentTokenString]);
-  aFloat:=TCSSFloatElement(CreateElement(TCSSFloatElement));
+  aFloat:=TCSSFloatElement(CreateElement(CSSFloatElementClass));
   try
   try
     Consume(ctkFloat);
     Consume(ctkFloat);
     aFloat.Value:=aValue;
     aFloat.Value:=aValue;
@@ -821,7 +857,7 @@ Var
   aURL : TCSSURLElement;
   aURL : TCSSURLElement;
 
 
 begin
 begin
-  aURL:=TCSSURLElement(CreateElement(TCSSURLElement));
+  aURL:=TCSSURLElement(CreateElement(CSSURLElementClass));
   try
   try
     aURL.Value:=CurrentTokenString;
     aURL.Value:=CurrentTokenString;
     if CurrentToken=ctkURL then
     if CurrentToken=ctkURL then
@@ -849,7 +885,7 @@ Var
 
 
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
-  aPseudo:=TCSSPseudoClassElement(CreateElement(TCSSPseudoClassElement));
+  aPseudo:=TCSSPseudoClassElement(CreateElement(CSSPseudoClassElementClass));
   try
   try
     Consume(ctkPseudo);
     Consume(ctkPseudo);
     aPseudo.Value:=aValue;
     aPseudo.Value:=aValue;
@@ -910,16 +946,16 @@ begin
   ctkEOF: exit(nil);
   ctkEOF: exit(nil);
   ctkSEMICOLON:
   ctkSEMICOLON:
     begin
     begin
-    Result:=TCSSRuleElement(CreateElement(TCSSRuleElement));
+    Result:=TCSSRuleElement(CreateElement(CSSRuleElementClass));
     exit;
     exit;
     end;
     end;
   end;
   end;
 
 
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
-  aRule:=TCSSRuleElement(CreateElement(TCSSRuleElement));
+  aRule:=TCSSRuleElement(CreateElement(CSSRuleElementClass));
   aList:=nil;
   aList:=nil;
   try
   try
-    aList:=TCSSListElement(CreateElement(TCSSListElement));
+    aList:=TCSSListElement(CreateElement(CSSListElementClass));
     While Not (CurrentToken in Term) do
     While Not (CurrentToken in Term) do
       begin
       begin
       aSel:=ParseSelector;
       aSel:=ParseSelector;
@@ -928,7 +964,7 @@ begin
         begin
         begin
         Consume(ctkCOMMA);
         Consume(ctkCOMMA);
         aRule.AddSelector(GetAppendElement(aList));
         aRule.AddSelector(GetAppendElement(aList));
-        aList:=TCSSListElement(CreateElement(TCSSListElement));
+        aList:=TCSSListElement(CreateElement(CSSListElementClass));
         end;
         end;
       end;
       end;
     // Note: no selectors is allowed
     // Note: no selectors is allowed
@@ -963,7 +999,7 @@ begin
   Result:=nil;
   Result:=nil;
   if not (CurrentToken in [ctkDOUBLECOLON, ctkMinus, ctkPlus, ctkDiv, ctkGT, ctkTILDE]) then
   if not (CurrentToken in [ctkDOUBLECOLON, ctkMinus, ctkPlus, ctkDiv, ctkGT, ctkTILDE]) then
     Raise ECSSParser.CreateFmt(SUnaryInvalidToken,[CurrentTokenString]);
     Raise ECSSParser.CreateFmt(SUnaryInvalidToken,[CurrentTokenString]);
-  Un:=TCSSUnaryElement(CreateElement(TCSSUnaryElement));
+  Un:=TCSSUnaryElement(CreateElement(CSSUnaryElementClass));
   try
   try
     op:=TokenToUnaryOperation(CurrentToken);
     op:=TokenToUnaryOperation(CurrentToken);
     Un.Operation:=op;
     Un.Operation:=op;
@@ -988,7 +1024,7 @@ Const
   var
   var
     Bin : TCSSBinaryElement;
     Bin : TCSSBinaryElement;
   begin
   begin
-    Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+    Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
     try
     try
       Bin.Left:=ALeft;
       Bin.Left:=ALeft;
       aLeft:=Nil;
       aLeft:=Nil;
@@ -1014,7 +1050,7 @@ Var
 
 
 begin
 begin
   aFactor:=Nil;
   aFactor:=Nil;
-  List:=TCSSListElement(CreateElement(TCSSListElement));
+  List:=TCSSListElement(CreateElement(CSSListElementClass));
   try
   try
     if AllowRules and (CurrentToken in [ctkLBRACE,ctkATKEYWORD]) then
     if AllowRules and (CurrentToken in [ctkLBRACE,ctkATKEYWORD]) then
       begin
       begin
@@ -1150,7 +1186,7 @@ begin
         begin
         begin
         if List=nil then
         if List=nil then
           begin
           begin
-          List:=TCSSListElement(CreateElement(TCSSListElement));
+          List:=TCSSListElement(CreateElement(CSSListElementClass));
           List.AddChild(El);
           List.AddChild(El);
           El:=List;
           El:=List;
           end;
           end;
@@ -1176,7 +1212,7 @@ begin
       ctkGT,ctkPLUS,ctkTILDE,ctkPIPE:
       ctkGT,ctkPLUS,ctkTILDE,ctkPIPE:
         begin
         begin
         // combinator
         // combinator
-        Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+        Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
         Bin.Left:=Result;
         Bin.Left:=Result;
         Result:=Bin;
         Result:=Bin;
         Bin.Operation:=TokenToBinaryOperation(CurrentToken);
         Bin.Operation:=TokenToBinaryOperation(CurrentToken);
@@ -1186,7 +1222,7 @@ begin
       ctkSTAR,ctkHASH,ctkIDENTIFIER,ctkCLASSNAME,ctkLBRACKET,ctkPSEUDO,ctkPSEUDOFUNCTION:
       ctkSTAR,ctkHASH,ctkIDENTIFIER,ctkCLASSNAME,ctkLBRACKET,ctkPSEUDO,ctkPSEUDOFUNCTION:
         begin
         begin
         // decendant combinator
         // decendant combinator
-        Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+        Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
         Bin.Left:=Result;
         Bin.Left:=Result;
         Result:=Bin;
         Result:=Bin;
         Bin.Operation:=boWhiteSpace;
         Bin.Operation:=boWhiteSpace;
@@ -1219,7 +1255,7 @@ Var
 
 
 begin
 begin
   Result:=Nil;
   Result:=Nil;
-  aArray:=TCSSArrayElement(CreateElement(TCSSArrayElement));
+  aArray:=TCSSArrayElement(CreateElement(CSSArrayElementClass));
   try
   try
     Consume(ctkLBRACKET);
     Consume(ctkLBRACKET);
     SkipWhiteSpace;
     SkipWhiteSpace;
@@ -1230,7 +1266,7 @@ begin
     ctkEQUALS,ctkTILDEEQUAL,ctkPIPEEQUAL,ctkSQUAREDEQUAL,ctkDOLLAREQUAL,ctkSTAREQUAL:
     ctkEQUALS,ctkTILDEEQUAL,ctkPIPEEQUAL,ctkSQUAREDEQUAL,ctkDOLLAREQUAL,ctkSTAREQUAL:
       begin
       begin
       // parse attr-matcher
       // parse attr-matcher
-      Bin:=TCSSBinaryElement(CreateElement(TCSSBinaryElement));
+      Bin:=TCSSBinaryElement(CreateElement(CSSBinaryElementClass));
       aArray.AddChild(Bin);
       aArray.AddChild(Bin);
       Bin.Left:=aEl;
       Bin.Left:=aEl;
       Bin.Operation:=TokenToBinaryOperation(aToken);
       Bin.Operation:=TokenToBinaryOperation(aToken);
@@ -1242,7 +1278,7 @@ begin
         Bin.Right:=ParseIdentifier;
         Bin.Right:=ParseIdentifier;
       ctkSTRING:
       ctkSTRING:
         begin
         begin
-        StrEl:=TCSSStringElement(CreateElement(TCSSStringElement));
+        StrEl:=TCSSStringElement(CreateElement(CSSStringElementClass));
         StrEl.Value:=CurrentTokenString;
         StrEl.Value:=CurrentTokenString;
         Bin.Right:=StrEl;
         Bin.Right:=StrEl;
         GetNextToken;
         GetNextToken;
@@ -1301,7 +1337,7 @@ Var
 
 
 begin
 begin
   aList:=nil;
   aList:=nil;
-  aDecl:= TCSSDeclarationElement(CreateElement(TCSSDeclarationElement));
+  aDecl:= TCSSDeclarationElement(CreateElement(CSSDeclarationElementClass));
   try
   try
     aPrevDisablePseudo:= Scanner.DisablePseudo;
     aPrevDisablePseudo:= Scanner.DisablePseudo;
     Scanner.DisablePseudo:=True;
     Scanner.DisablePseudo:=True;
@@ -1330,7 +1366,7 @@ begin
       end;
       end;
     Scanner.DisablePseudo:=aPrevDisablePseudo;
     Scanner.DisablePseudo:=aPrevDisablePseudo;
     aValue:=ParseComponentValue;
     aValue:=ParseComponentValue;
-    aList:=TCSSListElement(CreateElement(TCSSListElement));
+    aList:=TCSSListElement(CreateElement(CSSListElementClass));
     aList.AddChild(aValue);
     aList.AddChild(aValue);
     if aDecl.Colon then
     if aDecl.Colon then
       begin
       begin
@@ -1340,7 +1376,7 @@ begin
           begin
           begin
           Consume(ctkCOMMA);
           Consume(ctkCOMMA);
           aDecl.AddChild(GetAppendElement(aList));
           aDecl.AddChild(GetAppendElement(aList));
-          aList:=TCSSListElement(CreateElement(TCSSListElement));
+          aList:=TCSSListElement(CreateElement(CSSListElementClass));
           end;
           end;
         aValue:=ParseComponentValue;
         aValue:=ParseComponentValue;
         if aValue=nil then break;
         if aValue=nil then break;
@@ -1373,7 +1409,7 @@ var
 begin
 begin
   OldReturnWhiteSpace:=Scanner.ReturnWhiteSpace;
   OldReturnWhiteSpace:=Scanner.ReturnWhiteSpace;
   Scanner.ReturnWhiteSpace:=false;
   Scanner.ReturnWhiteSpace:=false;
-  aCall:=TCSSCallElement(CreateELement(TCSSCallElement));
+  aCall:=TCSSCallElement(CreateELement(CSSCallElementClass));
   try
   try
     if (aName='') then
     if (aName='') then
       aName:=CurrentTokenString;
       aName:=CurrentTokenString;
@@ -1455,7 +1491,7 @@ begin
     if El=nil then exit;
     if El=nil then exit;
     if IsUnary then
     if IsUnary then
       begin
       begin
-      Unary:=TCSSUnaryElement(CreateElement(TCSSUnaryElement));
+      Unary:=TCSSUnaryElement(CreateElement(CSSUnaryElementClass));
       aCall.AddArg(Unary);
       aCall.AddArg(Unary);
       Unary.Right:=El;
       Unary.Right:=El;
       Unary.Operation:=TokenToUnaryOperation(aToken);
       Unary.Operation:=TokenToUnaryOperation(aToken);
@@ -1489,10 +1525,10 @@ begin
       aCall.AddArg(ParseIdentifier);
       aCall.AddArg(ParseIdentifier);
     '-n':
     '-n':
       begin
       begin
-        aUnary:=TCSSUnaryElement(CreateElement(TCSSUnaryElement));
+        aUnary:=TCSSUnaryElement(CreateElement(CSSUnaryElementClass));
         aCall.AddArg(aUnary);
         aCall.AddArg(aUnary);
         aUnary.Operation:=uoMinus;
         aUnary.Operation:=uoMinus;
-        IdentEl:=TCSSIdentifierElement(CreateElement(TCSSIdentifierElement));
+        IdentEl:=TCSSIdentifierElement(CreateElement(CSSIdentifierElementClass));
         aUnary.Right:=IdentEl;
         aUnary.Right:=IdentEl;
         IdentEl.Value:='n';
         IdentEl.Value:='n';
         GetNextToken;
         GetNextToken;
@@ -1542,7 +1578,7 @@ Var
 
 
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
-  aStr:=TCSSStringElement(CreateElement(TCSSStringElement));
+  aStr:=TCSSStringElement(CreateElement(CSSStringElementClass));
   try
   try
     if CurrentToken=ctkSTRING then
     if CurrentToken=ctkSTRING then
       Consume(ctkSTRING)
       Consume(ctkSTRING)
@@ -1568,7 +1604,7 @@ Var
 
 
 begin
 begin
   aValue:=CurrentTokenString;
   aValue:=CurrentTokenString;
-  aRange:=TCSSUnicodeRangeElement(CreateElement(TCSSUnicodeRangeElement));
+  aRange:=TCSSUnicodeRangeElement(CreateElement(CSSUnicodeRangeElementClass));
   try
   try
     Consume(ctkUnicodeRange);
     Consume(ctkUnicodeRange);
     aRange.Value:=aValue;
     aRange.Value:=aValue;
@@ -1587,7 +1623,7 @@ Var
 
 
 begin
 begin
   Result:=Nil;
   Result:=Nil;
-  aArray:=TCSSArrayElement(CreateElement(TCSSArrayElement));
+  aArray:=TCSSArrayElement(CreateElement(CSSArrayElementClass));
   try
   try
     aArray.Prefix:=aPrefix;
     aArray.Prefix:=aPrefix;
     Consume(ctkLBRACKET);
     Consume(ctkLBRACKET);

+ 67 - 0
packages/fcl-css/src/fpcsstree.pp

@@ -60,6 +60,18 @@ Type
     procedure Visit(obj: TCSSElement); virtual; abstract;
     procedure Visit(obj: TCSSElement); virtual; abstract;
   end;
   end;
 
 
+  { TCSSVisitorFreeCustomData }
+
+  TCSSVisitorFreeCustomData = class(TCSSTreeVisitor)
+  public
+    procedure Visit(obj: TCSSElement); override;
+  end;
+
+  { TCSSElementOwnedData - base class for TCSSElement.CustomData which automatically freed }
+
+  TCSSElementOwnedData = class
+  end;
+
   { TCSSElement }
   { TCSSElement }
 
 
   TCSSElement = Class(TObject)
   TCSSElement = Class(TObject)
@@ -78,9 +90,11 @@ Type
     procedure IterateChildren(aVisitor : TCSSTreeVisitor); virtual;
     procedure IterateChildren(aVisitor : TCSSTreeVisitor); virtual;
   Public
   Public
     Constructor Create(const aFileName : TCSSString; aRow,aCol : Integer); virtual;
     Constructor Create(const aFileName : TCSSString; aRow,aCol : Integer); virtual;
+    destructor Destroy; override;
     Class function CSSType : TCSSType; virtual;
     Class function CSSType : TCSSType; virtual;
     function Equals(Obj: TObject): boolean; override;
     function Equals(Obj: TObject): boolean; override;
     Procedure Iterate(aVisitor : TCSSTreeVisitor);
     Procedure Iterate(aVisitor : TCSSTreeVisitor);
+    Procedure FreeCustomData; virtual; // free recursively CustomData
     Property CustomData : TObject Read FData Write FData;
     Property CustomData : TObject Read FData Write FData;
     Property SourceRow : Integer Read FRow;
     Property SourceRow : Integer Read FRow;
     Property SourceCol : Integer Read FCol;
     Property SourceCol : Integer Read FCol;
@@ -142,6 +156,7 @@ Type
     Property IsEscaped : Boolean Read FIsEscaped Write FIsEscaped;
     Property IsEscaped : Boolean Read FIsEscaped Write FIsEscaped;
     Property Units : TCSSUnits Read FUnits Write FUnits;
     Property Units : TCSSUnits Read FUnits Write FUnits;
   end;
   end;
+  TCSSIntegerElementClass = class of TCSSIntegerElement;
 
 
   { TCSSFloatElement }
   { TCSSFloatElement }
 
 
@@ -157,6 +172,7 @@ Type
     Property Value : Double Read FValue Write FValue;
     Property Value : Double Read FValue Write FValue;
     Property Units : TCSSUnits Read FUnits Write FUnits;
     Property Units : TCSSUnits Read FUnits Write FUnits;
   end;
   end;
+  TCSSFloatElementClass = class of TCSSFloatElement;
 
 
   { TCSSBaseUnaryElement }
   { TCSSBaseUnaryElement }
 
 
@@ -184,6 +200,7 @@ Type
     function Equals(Obj: TObject): boolean; override;
     function Equals(Obj: TObject): boolean; override;
     Property Operation : TCSSUnaryOperation Read FOperation Write FOperation;
     Property Operation : TCSSUnaryOperation Read FOperation Write FOperation;
   end;
   end;
+  TCSSUnaryElementClass = class of TCSSUnaryElement;
 
 
   { TCSSBinaryElement }
   { TCSSBinaryElement }
   TCSSBinaryOperation = (boEquals,boPlus,boMinus,boAnd,boLE,boLT,boGE,boGT,boDIV,
   TCSSBinaryOperation = (boEquals,boPlus,boMinus,boAnd,boLE,boLT,boGE,boGT,boDIV,
@@ -205,6 +222,7 @@ Type
     Property Left : TCSSElement Read FLeft Write SetLeft;
     Property Left : TCSSElement Read FLeft Write SetLeft;
     Property Operation : TCSSBinaryOperation Read FOperation Write FOperation;
     Property Operation : TCSSBinaryOperation Read FOperation Write FOperation;
   end;
   end;
+  TCSSBinaryElementClass = class of TCSSBinaryElement;
 
 
   { TCSSBaseStringElement }
   { TCSSBaseStringElement }
 
 
@@ -224,6 +242,7 @@ Type
   Public
   Public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSUnicodeRangeElementClass = class of TCSSUnicodeRangeElement;
 
 
   { TCSSURLElement }
   { TCSSURLElement }
 
 
@@ -231,6 +250,7 @@ Type
   public
   public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSURLElementClass = class of TCSSURLElement;
 
 
   { TCSSStringElement }
   { TCSSStringElement }
 
 
@@ -247,6 +267,7 @@ Type
     function Equals(Obj: TObject): boolean; override;
     function Equals(Obj: TObject): boolean; override;
     Property Children : TCSSElementList Read GetChildren;
     Property Children : TCSSElementList Read GetChildren;
   end;
   end;
+  TCSSStringElementClass = class of TCSSStringElement;
 
 
   { TCSSIdentifierElement }
   { TCSSIdentifierElement }
 
 
@@ -259,6 +280,7 @@ Type
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
     Property Name : TCSSString Read GetName;
     Property Name : TCSSString Read GetName;
   end;
   end;
+  TCSSIdentifierElementClass = class of TCSSIdentifierElement;
 
 
   { TCSSHashIdentifierElement }
   { TCSSHashIdentifierElement }
 
 
@@ -268,6 +290,7 @@ Type
   Public
   Public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSHashIdentifierElementClass = class of TCSSHashIdentifierElement;
 
 
   { TCSSClassNameElement }
   { TCSSClassNameElement }
 
 
@@ -277,6 +300,7 @@ Type
   Public
   Public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSClassNameElementClass = class of TCSSClassNameElement;
 
 
   { TCSSPseudoClassElement }
   { TCSSPseudoClassElement }
 
 
@@ -286,6 +310,7 @@ Type
   Public
   Public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSPseudoClassElementClass = class of TCSSPseudoClassElement;
 
 
   { TCSSChildrenElement }
   { TCSSChildrenElement }
 
 
@@ -318,6 +343,7 @@ Type
     function Equals(Obj: TObject): boolean; override;
     function Equals(Obj: TObject): boolean; override;
     Property Prefix : TCSSElement Read FPrefix Write SetPrefix;
     Property Prefix : TCSSElement Read FPrefix Write SetPrefix;
   end;
   end;
+  TCSSArrayElementClass = class of TCSSArrayElement;
 
 
   { TCSSCallElement }
   { TCSSCallElement }
 
 
@@ -336,6 +362,7 @@ Type
     Property ArgCount : Integer Read GetArgCount;
     Property ArgCount : Integer Read GetArgCount;
     Property Name : TCSSString Read FName Write FName;
     Property Name : TCSSString Read FName Write FName;
   end;
   end;
+  TCSSCallElementClass = class of TCSSCallElement;
 
 
   { TCSSDeclarationElement }
   { TCSSDeclarationElement }
 
 
@@ -359,6 +386,7 @@ Type
     Property IsImportant : Boolean Read FIsImportant Write FIsImportant;
     Property IsImportant : Boolean Read FIsImportant Write FIsImportant;
     Property Colon : Boolean Read FColon Write FColon;
     Property Colon : Boolean Read FColon Write FColon;
   end;
   end;
+  TCSSDeclarationElementClass = class of TCSSDeclarationElement;
 
 
   { TCSSListElement }
   { TCSSListElement }
 
 
@@ -368,6 +396,7 @@ Type
   Public
   Public
     Function ExtractElement(aIndex : Integer) : TCSSElement;
     Function ExtractElement(aIndex : Integer) : TCSSElement;
   end;
   end;
+  TCSSListElementClass = class of TCSSListElement;
 
 
   { TCSSCompoundElement }
   { TCSSCompoundElement }
 
 
@@ -377,6 +406,7 @@ Type
   Public
   Public
     Class function CSSType : TCSSType; override;
     Class function CSSType : TCSSType; override;
   end;
   end;
+  TCSSCompoundElementClass = class of TCSSCompoundElement;
 
 
   { TCSSRuleElement }
   { TCSSRuleElement }
 
 
@@ -397,6 +427,8 @@ Type
     Property Selectors [aIndex : Integer] : TCSSElement Read GetSelector;
     Property Selectors [aIndex : Integer] : TCSSElement Read GetSelector;
     Property SelectorCount : Integer Read GetSelectorCount;
     Property SelectorCount : Integer Read GetSelectorCount;
   end;
   end;
+  TCSSRuleElementClass = class of TCSSRuleElement;
+  TCSSRuleElementArray = array of TCSSRuleElement;
 
 
   { TCSSAtRuleElement }
   { TCSSAtRuleElement }
 
 
@@ -408,6 +440,7 @@ Type
     function Equals(Obj: TObject): boolean; override;
     function Equals(Obj: TObject): boolean; override;
     Property AtKeyWord : TCSSString Read FAtKeyWord Write FAtKeyWord;
     Property AtKeyWord : TCSSString Read FAtKeyWord Write FAtKeyWord;
   end;
   end;
+  TCSSAtRuleElementClass = class of TCSSAtRuleElement;
 
 
 
 
 // Convert unicode codepoints to \0000 notation
 // Convert unicode codepoints to \0000 notation
@@ -1518,6 +1551,16 @@ begin
   FCol:=aCol;
   FCol:=aCol;
 end;
 end;
 
 
+destructor TCSSElement.Destroy;
+begin
+  if FData is TCSSElementOwnedData then
+  begin
+    FData.Free;
+    FData:=nil;
+  end;
+  inherited Destroy;
+end;
+
 class function TCSSElement.CSSType: TCSSType;
 class function TCSSElement.CSSType: TCSSType;
 begin
 begin
   Result:=csstUnknown;
   Result:=csstUnknown;
@@ -1544,5 +1587,29 @@ begin
   IterateChildren(aVisitor);
   IterateChildren(aVisitor);
 end;
 end;
 
 
+procedure TCSSElement.FreeCustomData;
+var
+  Visitor: TCSSVisitorFreeCustomData;
+begin
+  Visitor:=TCSSVisitorFreeCustomData.Create;
+  try
+    Iterate(Visitor);
+  finally
+    Visitor.Free;
+  end;
+end;
+
+{ TCSSVisitorFreeCustomData }
+
+procedure TCSSVisitorFreeCustomData.Visit(obj: TCSSElement);
+var
+  d: TObject;
+begin
+  if obj.CustomData=nil then exit;
+  d:=obj.CustomData;
+  obj.CustomData:=nil;
+  d.Free;
+end;
+
 end.
 end.