fcl-css: selector child combinator

packages/fcl-css/src/fpcssresolver.pas

@@ -50,9 +50,11 @@ type
   { TCSSNode }
 
   TCSSNode = interface
-    function GetCSSClassName: String;
+    function GetCSSID: TCSSString;
+    function GetCSSTypeName: TCSSString;
     function GetCSSTypeID: TCSSNumericalID;
-    function HasCSSClass(const aClassName: string): boolean;
+    function HasCSSClass(const aClassName: TCSSString): boolean;
+    function GetCSSParent: TCSSNode;
     procedure SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement);
   end;
 
@@ -65,7 +67,7 @@ type
   TCSSNumericalIDKinds = set of TCSSNumericalIDKind;
 
 const
-  CSSNumericalIDKindNames: array[TCSSNumericalIDKind] of string = (
+  CSSNumericalIDKindNames: array[TCSSNumericalIDKind] of TCSSString = (
     'Type',
     'Attribute',
     'PseudoAttribute'
@@ -79,13 +81,13 @@ type
   private
     FKind: TCSSNumericalIDKind;
     fList: TFPHashList;
-    function GetIDs(const aName: string): TCSSNumericalID;
-    procedure SetIDs(const aName: string; const AValue: TCSSNumericalID);
+    function GetIDs(const aName: TCSSString): TCSSNumericalID;
+    procedure SetIDs(const aName: TCSSString; const AValue: TCSSNumericalID);
   public
     constructor Create(aKind: TCSSNumericalIDKind);
     destructor Destroy; override;
     procedure Clear;
-    property IDs[const aName: string]: TCSSNumericalID read GetIDs write SetIDs; default;
+    property IDs[const aName: TCSSString]: TCSSNumericalID read GetIDs write SetIDs; default;
     property Kind: TCSSNumericalIDKind read FKind;
   end;
 
@@ -143,6 +145,11 @@ type
     procedure ComputeElement(El: TCSSElement); virtual;
     procedure ComputeRule(aRule: TCSSRuleElement); virtual;
     function SelectorMatches(aSelector: TCSSElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorIdentifierMatches(Identifier: TCSSIdentifierElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorClassNameMatches(aClassName: TCSSClassNameElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorStringMatches(aString: TCSSStringElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorListMatches(aList: TCSSListElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorBinaryMatches(aBinary: TCSSBinaryElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
     procedure MergeProperty(El: TCSSElement; Specifity: TCSSSpecifity); virtual;
     function ResolveIdentifier(El: TCSSIdentifierElement; Kind: TCSSNumericalIDKind): TCSSNumericalID; virtual;
     function FindComputedAttribute(AttrID: TCSSNumericalID): PCSSComputedAttribute;
@@ -170,14 +177,14 @@ implementation
 
 { TCSSNumericalIDs }
 
-function TCSSNumericalIDs.GetIDs(const aName: string): TCSSNumericalID;
+function TCSSNumericalIDs.GetIDs(const aName: TCSSString): TCSSNumericalID;
 begin
   {$WARN 4056 off : Conversion between ordinals and pointers is not portable}
   Result:=TCSSNumericalID(fList.Find(aName));
   {$WARN 4056 on}
 end;
 
-procedure TCSSNumericalIDs.SetIDs(const aName: string;
+procedure TCSSNumericalIDs.SetIDs(const aName: TCSSString;
   const AValue: TCSSNumericalID);
 var
   i: Integer;
@@ -284,34 +291,107 @@ function TCSSResolver.SelectorMatches(aSelector: TCSSElement;
   const TestNode: TCSSNode): TCSSSpecifity;
 var
   C: TClass;
-  Identifier: TCSSIdentifierElement;
-  TypeID: TCSSNumericalID;
-  aClassName: TCSSString;
 begin
   Result:=-1;
   C:=aSelector.ClassType;
   if C=TCSSIdentifierElement then
+    Result:=SelectorIdentifierMatches(TCSSIdentifierElement(aSelector),TestNode)
+  else if C=TCSSClassNameElement then
+    Result:=SelectorClassNameMatches(TCSSClassNameElement(aSelector),TestNode)
+  else if C=TCSSStringElement then
+    Result:=SelectorStringMatches(TCSSStringElement(aSelector),TestNode)
+  else if C=TCSSBinaryElement then
+    Result:=SelectorBinaryMatches(TCSSBinaryElement(aSelector),TestNode)
+  else if C=TCSSListElement then
+    Result:=SelectorListMatches(TCSSListElement(aSelector),TestNode)
+  else
+    DoError(20220908230152,'Unknown CSS selector element',aSelector);
+end;
+
+function TCSSResolver.SelectorIdentifierMatches(
+  Identifier: TCSSIdentifierElement; const TestNode: TCSSNode): TCSSSpecifity;
+var
+  TypeID: TCSSNumericalID;
+begin
+  Result:=-1;
+  TypeID:=ResolveIdentifier(Identifier,nikType);
+  if TypeID=CSSTypeIDUniversal then
   begin
-    Identifier:=TCSSIdentifierElement(aSelector);
-    TypeID:=ResolveIdentifier(Identifier,nikType);
-    if TypeID=CSSTypeIDUniversal then
-    begin
-      // universal selector
-      Result:=0;
-    end else if TypeID<>CSSIDNone then
-    begin
-      if TypeID=TestNode.GetCSSTypeID then
-        Result:=CSSSpecifityType;
-    end else
-      DoError(20220908230426,'Unknown CSS selector type name "'+Identifier.Name+'"',Identifier);
-  end else if C=TCSSClassNameElement then
+    // universal selector
+    Result:=0;
+  end else if TypeID<>CSSIDNone then
   begin
-    Identifier:=TCSSIdentifierElement(aSelector);
-    aClassName:=copy(Identifier.Name,2,255);
-    if TestNode.HasCSSClass(aClassName) then
-      Result:=CSSSpecifityClass;
+    if TypeID=TestNode.GetCSSTypeID then
+      Result:=CSSSpecifityType;
   end else
-    DoError(20220908230152,'Unknown CSS selector element',aSelector);
+    DoError(20220908230426,'Unknown CSS selector type name "'+Identifier.Name+'"',Identifier);
+end;
+
+function TCSSResolver.SelectorClassNameMatches(
+  aClassName: TCSSClassNameElement; const TestNode: TCSSNode): TCSSSpecifity;
+var
+  aValue: TCSSString;
+begin
+  aValue:=copy(aClassName.Name,2,255);
+  if TestNode.HasCSSClass(aValue) then
+    Result:=CSSSpecifityClass
+  else
+    Result:=-1;
+end;
+
+function TCSSResolver.SelectorStringMatches(aString: TCSSStringElement;
+  const TestNode: TCSSNode): TCSSSpecifity;
+var
+  aValue: TCSSString;
+begin
+  Result:=-1;
+  if aString.Children.Count>0 then
+    DoError(20220910113909,'Invalid CSS string selector',aString.Children[0]);
+  aValue:=aString.Value;
+  if aValue[1]<>'#' then
+    DoError(20220910114014,'Invalid CSS selector',aString);
+  System.Delete(aValue,1,1);
+  if aValue='' then
+    DoError(20220910114133,'Invalid CSS identifier selector',aString);
+  if aValue=TestNode.GetCSSID then
+    Result:=CSSSpecifityIdentifier;
+end;
+
+function TCSSResolver.SelectorListMatches(aList: TCSSListElement;
+  const TestNode: TCSSNode): TCSSSpecifity;
+var
+  i: Integer;
+begin
+  Result:=-1;
+  writeln('TCSSResolver.SelectorListMatches ChildCount=',aList.ChildCount);
+  for i:=0 to aList.ChildCount-1 do
+    writeln('TCSSResolver.SelectorListMatches ',i,' ',GetCSSObj(aList.Children[i]),' AsString=',aList.Children[i].AsString);
+  DoError(20220910115531,'Invalid CSS list selector',aList);
+end;
+
+function TCSSResolver.SelectorBinaryMatches(aBinary: TCSSBinaryElement;
+  const TestNode: TCSSNode): TCSSSpecifity;
+var
+  aParent: TCSSNode;
+  ParentSpecifity: TCSSSpecifity;
+begin
+  Result:=-1;
+  case aBinary.Operation of
+  boGT:
+    begin
+      Result:=SelectorMatches(aBinary.Right,TestNode);
+      if Result<0 then exit;
+      aParent:=TestNode.GetCSSParent;
+      if aParent=nil then
+        exit(-1);
+      ParentSpecifity:=SelectorMatches(aBinary.Left,aParent);
+      if ParentSpecifity<0 then
+        exit(-1);
+      inc(Result,ParentSpecifity);
+    end
+  else
+    DoError(20220910123724,'Invalid CSS binary selector '+BinaryOperators[aBinary.Operation],aBinary);
+  end;
 end;
 
 procedure TCSSResolver.MergeProperty(El: TCSSElement; Specifity: TCSSSpecifity);

packages/fcl-css/src/fpcssscanner.pp

@@ -484,10 +484,9 @@ begin
   Move(TokenStart^,FCurTokenString[1],Len);
   if IsEscape then
     begin
-    result:=ctkString;
+    Result:=ctkString;
     FCurTokenString:=Char(StrToInt(FCurTokenString));
     end;
-
 end;
 
 function TCSSScanner.DoHash :TCSSToken;

packages/fcl-css/src/fpcsstree.pp

@@ -366,6 +366,7 @@ Function StringToCSSString(const S : TCSSString) : TCSSString;
 // Escapes non-identifier characters C to \C
 Function StringToIdentifier(const S : TCSSString) : TCSSString;
 
+Function GetCSSObj(El: TCSSElement): TCSSString;
 Function GetCSSPath(El: TCSSElement): TCSSString;
 
 Const
@@ -484,6 +485,16 @@ begin
   SetLength(Result,iOut);
 end;
 
+function GetCSSObj(El: TCSSElement): TCSSString;
+begin
+  if El=nil then
+    Result:='nil'
+  else if El is TCSSIdentifierElement then
+    Result:=El.ClassName+'"'+TCSSIdentifierElement(El).Name+'"'
+  else
+    Result:=El.ClassName;
+end;
+
 function GetCSSPath(El: TCSSElement): TCSSString;
 begin
   if El=nil then
@@ -493,10 +504,7 @@ begin
     begin
     if Result<>'' then
       Result:='.'+Result;
-    if El is TCSSIdentifierElement then
-      Result:=El.ClassName+'"'+TCSSIdentifierElement(El).Name+'"'+Result
-    else
-      Result:=El.ClassName+Result;
+    Result:=GetCSSObj(El)+Result;
     El:=El.Parent;
     end;
 end;

packages/fcl-css/tests/tccssresolver.pp

@@ -66,7 +66,6 @@ type
     FAttributeValues: array[TDemoNodeAttribute] of string;
     FNodes: TFPObjectList; // list of TDemoNode
     FCSSClasses: TStrings;
-    FID: string;
     FParent: TDemoNode;
     FStyleElements: TCSSElement;
     FStyle: string;
@@ -74,7 +73,6 @@ type
     function GetNodeCount: integer;
     function GetNodes(Index: integer): TDemoNode;
     procedure SetAttribute(AIndex: TDemoNodeAttribute; const AValue: string);
-    procedure SetID(const AValue: string);
     procedure SetParent(const AValue: TDemoNode);
     procedure SetStyleElements(const AValue: TCSSElement);
     procedure SetStyle(const AValue: string);
@@ -85,14 +83,15 @@ type
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Clear;
-    class function CSSClassName: string; virtual;
-    function GetCSSClassName: string;
+    function GetCSSID: TCSSString; virtual;
+    class function CSSTypeName: TCSSString; virtual;
+    function GetCSSTypeName: TCSSString;
     class function CSSTypeID: TCSSNumericalID; virtual;
     function GetCSSTypeID: TCSSNumericalID;
     class function GetAttributeInitialValue(Attr: TDemoNodeAttribute): string; virtual;
-    function HasCSSClass(const aClassName: string): boolean; virtual;
+    function HasCSSClass(const aClassName: TCSSString): boolean; virtual;
     procedure SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement); virtual;
-    property ID: string read FID write SetID;
+    function GetCSSParent: TCSSNode; virtual;
     property Parent: TDemoNode read FParent write SetParent;
     property NodeCount: integer read GetNodeCount;
     property Nodes[Index: integer]: TDemoNode read GetNodes; default;
@@ -109,12 +108,21 @@ type
     property Color: string index naColor read GetAttribute write SetAttribute;
     property Attribute[Attr: TDemoNodeAttribute]: string read GetAttribute write SetAttribute;
   end;
+  TDemoNodeClass = class of TDemoNode;
+
+  { TDemoDiv }
+
+  TDemoDiv = class(TDemoNode)
+  public
+    class function CSSTypeName: TCSSString; override;
+    class function CSSTypeID: TCSSNumericalID; override;
+  end;
 
   { TDemoButton }
 
   TDemoButton = class(TDemoNode)
   public
-    class function CSSClassName: string; override;
+    class function CSSTypeName: TCSSString; override;
     class function CSSTypeID: TCSSNumericalID; override;
   end;
 
@@ -162,14 +170,21 @@ type
 
   TTestCSSResolver = class(TCustomTestCSSResolver)
   published
-    procedure Test_Universal;
+    procedure Test_Selector_Universal;
+    procedure Test_Selector_Type;
+    procedure Test_Selector_Id;
+    procedure Test_Selector_Class;
+    procedure Test_Selector_ClassClass; // and operator
+    procedure Test_Selector_ClassSpaceClass; // descendant combinator
+    procedure Test_Selector_TypeCommaType; // or operator
+    procedure Test_Selector_ClassGTClass; // child combinator
   end;
 
-function LinesToStr(Args: array of const): string;
+function LinesToStr(const Args: array of const): string;
 
 implementation
 
-function LinesToStr(Args: array of const): string;
+function LinesToStr(const Args: array of const): string;
 var
   s: String;
   i: Integer;
@@ -205,24 +220,167 @@ end;
 
 { TTestCSSResolver }
 
-procedure TTestCSSResolver.Test_Universal;
+procedure TTestCSSResolver.Test_Selector_Universal;
 begin
   Doc.Root:=TDemoNode.Create(nil);
   Doc.Style:='* { left: 10px; }';
   Doc.ApplyStyle;
-  AssertEquals('left','10px',Doc.Root.Left);
+  AssertEquals('Root.left','10px',Doc.Root.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_Type;
+var
+  Button: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Button:=TDemoButton.Create(Doc);
+  Button.Parent:=Doc.Root;
+  Doc.Style:='button { left: 11px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button.left','11px',Button.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_Id;
+var
+  Button1: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Button1:=TDemoButton.Create(Doc);
+  Button1.Name:='Button1';
+  Button1.Parent:=Doc.Root;
+  Doc.Style:='#Button1 { left: 12px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button1.left','12px',Button1.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_Class;
+var
+  Button1: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Button1:=TDemoButton.Create(Doc);
+  Button1.CSSClasses.Add('west');
+  Button1.Parent:=Doc.Root;
+  Doc.Style:='.west { left: 13px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button1.left','13px',Button1.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_ClassClass;
+var
+  Button1, Button2: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+
+  Button1:=TDemoButton.Create(Doc);
+  Button1.CSSClasses.Add('west');
+  Button1.Parent:=Doc.Root;
+
+  Button2:=TDemoButton.Create(Doc);
+  Button2.CSSClasses.Add('west south');
+  Button2.Parent:=Doc.Root;
+
+  Doc.Style:='.west.south { left: 10px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button1.left','',Button1.Left);
+  AssertEquals('Button2.left','10px',Button2.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_ClassSpaceClass;
+var
+  Button1: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Doc.Root.CSSClasses.Add('bird');
+
+  Button1:=TDemoButton.Create(Doc);
+  Button1.CSSClasses.Add('west');
+  Button1.Parent:=Doc.Root;
+
+  Doc.Style:='.bird .west { left: 10px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button1.left','10px',Button1.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_TypeCommaType;
+var
+  Button1: TDemoButton;
+  Div1: TDemoDiv;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+
+  Button1:=TDemoButton.Create(Doc);
+  Button1.Parent:=Doc.Root;
+
+  Div1:=TDemoDiv.Create(Doc);
+  Div1.Parent:=Doc.Root;
+
+  Doc.Style:='div, button { left: 10px; }';
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Button1.left','10px',Button1.Left);
+  AssertEquals('Div1.left','10px',Div1.Left);
+end;
+
+procedure TTestCSSResolver.Test_Selector_ClassGTClass;
+var
+  Div1, Div2: TDemoDiv;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Doc.Root.CSSClasses.Add('lvl1');
+
+  Div1:=TDemoDiv.Create(Doc);
+  Div1.CSSClasses.Add('lvl2');
+  Div1.Parent:=Doc.Root;
+
+  Div2:=TDemoDiv.Create(Doc);
+  Div2.CSSClasses.Add('lvl3');
+  Div2.Parent:=Div1;
+
+  Doc.Style:=LinesToStr([
+  '.lvl1>.lvl2 { left: 10px; }',
+  '.lvl1>.lvl3 { top: 11px; }',
+  '.lvl2>.lvl3 { width: 12px; }',
+  '']);
+  Doc.ApplyStyle;
+  AssertEquals('Root.left','',Doc.Root.Left);
+  AssertEquals('Root.top','',Doc.Root.Top);
+  AssertEquals('Root.width','',Doc.Root.Width);
+  AssertEquals('Div1.left','10px',Div1.Left);
+  AssertEquals('Div1.top','',Div1.Top);
+  AssertEquals('Div1.width','',Div1.Width);
+  AssertEquals('Div2.left','',Div2.Left);
+  AssertEquals('Div2.top','',Div2.Top);
+  AssertEquals('Div2.width','12px',Div2.Width);
+end;
+
+{ TDemoDiv }
+
+class function TDemoDiv.CSSTypeName: TCSSString;
+begin
+  Result:='div';
+end;
+
+class function TDemoDiv.CSSTypeID: TCSSNumericalID;
+begin
+  Result:=101;
 end;
 
 { TDemoButton }
 
-class function TDemoButton.CSSClassName: string;
+class function TDemoButton.CSSTypeName: TCSSString;
 begin
   Result:='button';
 end;
 
 class function TDemoButton.CSSTypeID: TCSSNumericalID;
 begin
-  Result:=101;
+  Result:=102;
 end;
 
 { TDemoDocument }
@@ -279,8 +437,9 @@ begin
   if TypeIDs['*']<>CSSTypeIDUniversal then
     raise Exception.Create('20220909004740');
 
-  TypeIDs[TDemoNode.CSSClassName]:=TDemoNode.CSSTypeID;
-  TypeIDs[TDemoButton.CSSClassName]:=TDemoButton.CSSTypeID;
+  TypeIDs[TDemoNode.CSSTypeName]:=TDemoNode.CSSTypeID;
+  TypeIDs[TDemoDiv.CSSTypeName]:=TDemoDiv.CSSTypeID;
+  TypeIDs[TDemoButton.CSSTypeName]:=TDemoButton.CSSTypeID;
 
   AttributeIDs:=FNumericalIDs[nikAttribute];
   AttributeIDs['all']:=CSSAttributeIDAll;
@@ -352,12 +511,6 @@ begin
   FAttributeValues[AIndex]:=AValue;
 end;
 
-procedure TDemoNode.SetID(const AValue: string);
-begin
-  if FID=AValue then Exit;
-  FID:=AValue;
-end;
-
 procedure TDemoNode.SetParent(const AValue: TDemoNode);
 begin
   if FParent=AValue then Exit;
@@ -441,7 +594,12 @@ begin
   FNodes.Clear;
 end;
 
-class function TDemoNode.CSSClassName: string;
+function TDemoNode.GetCSSID: TCSSString;
+begin
+  Result:=Name;
+end;
+
+class function TDemoNode.CSSTypeName: TCSSString;
 begin
   Result:='node';
 end;
@@ -460,7 +618,7 @@ begin
   end;
 end;
 
-function TDemoNode.HasCSSClass(const aClassName: string): boolean;
+function TDemoNode.HasCSSClass(const aClassName: TCSSString): boolean;
 var
   i: Integer;
 begin
@@ -485,9 +643,14 @@ begin
   Attribute[Attr]:=s;
 end;
 
-function TDemoNode.GetCSSClassName: string;
+function TDemoNode.GetCSSParent: TCSSNode;
+begin
+  Result:=Parent;
+end;
+
+function TDemoNode.GetCSSTypeName: TCSSString;
 begin
-  Result:=CSSClassName;
+  Result:=CSSTypeName;
 end;
 
 class function TDemoNode.CSSTypeID: TCSSNumericalID;