fcl-css: started calls

packages/fcl-css/src/fpcssresolver.pas

@@ -58,6 +58,7 @@ const
   CSSPseudoID_FirstOfType = 6; // :first-of-type
   CSSPseudoID_LastOfType = 7; // :last-of-type
   CSSPseudoID_OnlyOfType = 8; // :only-of-type
+  CSSCallID_NthChild = 9; // :nth-child
 
 type
   TCSSMsgID = int64;
@@ -158,6 +159,11 @@ type
     NormValue: string;
   end;
 
+  TCSSCallData = class(TCSSElResolverData)
+  public
+    NumericalID: TCSSNumericalID;
+  end;
+
   TCSSResolverOption = (
     croErrorOnUnknownName
     );
@@ -172,6 +178,12 @@ const
   DefaultCSSComputeOptions = [ccoCommit];
 
 type
+  TCSSResStringComparison = (
+    crscDefault,
+    crscCaseInsensitive,
+    crscCaseSensitive
+    );
+  TCSSResStringComparisons = set of TCSSResStringComparison;
 
   { TCSSResolver }
 
@@ -179,6 +191,7 @@ type
   private
     FNumericalIDs: array[TCSSNumericalIDKind] of TCSSNumericalIDs;
     FOptions: TCSSResolverOptions;
+    FStringComparison: TCSSResStringComparison;
     FStyle: TCSSElement;
     FOwnsStyle: boolean;
     FFirstElData: TCSSElResolverData;
@@ -204,10 +217,16 @@ type
     function SelectorBinaryMatches(aBinary: TCSSBinaryElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
     function SelectorArrayMatches(anArray: TCSSArrayElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
     function SelectorArrayBinaryMatches(aBinary: TCSSBinaryElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function SelectorCallMatches(aCall: TCSSCallElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
+    function Call_NthChild(aCall: TCSSCallElement; const TestNode: TCSSNode): TCSSSpecifity; virtual;
     function ComputeValue(El: TCSSElement): TCSSString; virtual;
+    function SameValueText(const A, B: TCSSString): boolean; virtual;
+    function SameValueText(A: PChar; ALen: integer; B: PChar; BLen: integer): boolean; virtual;
+    function PosSubString(const SearchStr, Str: TCSSString): integer; virtual;
     function PosWord(const SearchWord, Words: TCSSString): integer; virtual;
     procedure MergeProperty(El: TCSSElement; Specifity: TCSSSpecifity); virtual;
     function ResolveIdentifier(El: TCSSIdentifierElement; Kind: TCSSNumericalIDKind): TCSSNumericalID; virtual;
+    function ResolveCall(El: TCSSCallElement): TCSSNumericalID; virtual;
     procedure AddElData(El: TCSSElement; ElData: TCSSElResolverData); virtual;
     function AddElValueData(El: TCSSElement; const aValue: TCSSString): TCSSValueData; virtual;
     function FindComputedAttribute(AttrID: TCSSNumericalID): PCSSComputedAttribute;
@@ -229,6 +248,7 @@ type
     property Options: TCSSResolverOptions read FOptions write SetOptions;
     property Attributes[Index: integer]: PCSSComputedAttribute read GetAttributes;
     property AttributeCount: integer read FAttributeCount;
+    property StringComparison: TCSSResStringComparison read FStringComparison;
   end;
 
 implementation
@@ -378,6 +398,8 @@ begin
     Result:=SelectorArrayMatches(TCSSArrayElement(aSelector),TestNode)
   else if C=TCSSListElement then
     Result:=SelectorListMatches(TCSSListElement(aSelector),TestNode)
+  else if C=TCSSCallElement then
+    Result:=SelectorCallMatches(TCSSCallElement(aSelector),TestNode)
   else
     DoError(20220908230152,'Unknown CSS selector element',aSelector);
 end;
@@ -592,44 +614,71 @@ var
   AttrID: TCSSNumericalID;
   {$IFDEF VerboseCSSResolver}
   i: integer;
+  aValue: TCSSString;
+  OldStringComparison: TCSSResStringComparison;
   {$ENDIF}
 begin
   Result:=CSSSpecifityInvalid;
   if anArray.Prefix<>nil then
-    DoError(20220910154004,'Invalid CSS array selector prefix',anArray.Prefix);
+    DoError(20220910154004,'Invalid CSS attribute selector prefix',anArray.Prefix);
   {$IFDEF VerboseCSSResolver}
   writeln('TCSSResolver.SelectorArrayMatches Prefix=',GetCSSObj(anArray.Prefix),' ChildCount=',anArray.ChildCount);
   for i:=0 to anArray.ChildCount-1 do
     writeln('TCSSResolver.SelectorArrayMatches ',i,' ',GetCSSObj(anArray.Children[i]));
   {$ENDIF}
-  if anArray.ChildCount<>1 then
-    DoError(20220910154033,'Invalid CSS array selector',anArray);
-  El:=anArray.Children[0];
-  C:=El.ClassType;
-  if C=TCSSIdentifierElement then
-  begin
-    // [name]  ->  has attribute name
-    AttrID:=ResolveIdentifier(TCSSIdentifierElement(El),nikAttribute);
-    case AttrID of
-    CSSIDNone:
-      Result:=CSSSpecifityNoMatch;
-    CSSAttributeID_ID,
-    CSSAttributeID_Class:
-      // basic CSS attributes are always defined
-      Result:=CSSSpecifityClass;
-    CSSAttributeID_All:
-      // special CSS attributes without a value
-      Result:=CSSSpecifityNoMatch;
-    else
-      if TestNode.HasCSSAttribute(AttrID) then
-        Result:=CSSSpecifityClass
-      else
+  if anArray.ChildCount<1 then
+    DoError(20220910154033,'Invalid CSS attribute selector',anArray);
+  OldStringComparison:=StringComparison;
+  try
+    if anArray.ChildCount>1 then
+      begin
+      El:=anArray.Children[1];
+      C:=El.ClassType;
+      if C=TCSSIdentifierElement then
+      begin
+        aValue:=TCSSIdentifierElement(El).Value;
+        case aValue of
+        'i': FStringComparison:=crscCaseInsensitive;
+        's': FStringComparison:=crscCaseSensitive;
+        else
+          if croErrorOnUnknownName in Options then
+            DoError(20220914174409,'Invalid attribute modifier "'+aValue+'"',El);
+        end;
+      end else
+        DoError(20220914173643,'Invalid CSS attribute modifier',El);
+      end;
+    if (anArray.ChildCount>2) and (croErrorOnUnknownName in Options) then
+      DoError(20220914174550,'Invalid CSS attribute modifier',anArray.Children[2]);
+
+    El:=anArray.Children[0];
+    C:=El.ClassType;
+    if C=TCSSIdentifierElement then
+    begin
+      // [name]  ->  has attribute name
+      AttrID:=ResolveIdentifier(TCSSIdentifierElement(El),nikAttribute);
+      case AttrID of
+      CSSIDNone:
         Result:=CSSSpecifityNoMatch;
-    end;
-  end else if C=TCSSBinaryElement then
-    Result:=SelectorArrayBinaryMatches(TCSSBinaryElement(El),TestNode)
-  else
-    DoError(20220910153725,'Invalid CSS array selector',El);
+      CSSAttributeID_ID,
+      CSSAttributeID_Class:
+        // basic CSS attributes are always defined
+        Result:=CSSSpecifityClass;
+      CSSAttributeID_All:
+        // special CSS attributes without a value
+        Result:=CSSSpecifityNoMatch;
+      else
+        if TestNode.HasCSSAttribute(AttrID) then
+          Result:=CSSSpecifityClass
+        else
+          Result:=CSSSpecifityNoMatch;
+      end;
+    end else if C=TCSSBinaryElement then
+      Result:=SelectorArrayBinaryMatches(TCSSBinaryElement(El),TestNode)
+    else
+      DoError(20220910153725,'Invalid CSS array selector',El);
+  finally
+    FStringComparison:=OldStringComparison;
+  end;
 end;
 
 function TCSSResolver.SelectorArrayBinaryMatches(aBinary: TCSSBinaryElement;
@@ -673,21 +722,21 @@ begin
   {$ENDIF}
   case aBinary.Operation of
   boEquals:
-    if LeftValue=RightValue then
+    if SameValueText(LeftValue,RightValue) then
       Result:=CSSSpecifityClass;
   boSquaredEqual:
     // begins with
-    if (RightValue<>'') and (LeftStr(LeftValue,length(RightValue))=RightValue) then
+    if (RightValue<>'') and SameValueText(LeftStr(LeftValue,length(RightValue)),RightValue) then
       Result:=CSSSpecifityClass;
   boDollarEqual:
     // ends with
-    if (RightValue<>'') and (RightStr(LeftValue,length(RightValue))=RightValue) then
+    if (RightValue<>'') and SameValueText(RightStr(LeftValue,length(RightValue)),RightValue) then
       Result:=CSSSpecifityClass;
   boPipeEqual:
     // equal to or starts with name-hyphen
     if (RightValue<>'')
-        and ((LeftValue=RightValue)
-          or (LeftStr(LeftValue,length(RightValue)+1)=RightValue+'-')) then
+        and (SameValueText(LeftValue,RightValue)
+          or SameValueText(LeftStr(LeftValue,length(RightValue)+1),RightValue+'-')) then
       Result:=CSSSpecifityClass;
   boStarEqual:
     // contains substring
@@ -707,6 +756,35 @@ begin
   {$ENDIF}
 end;
 
+function TCSSResolver.SelectorCallMatches(aCall: TCSSCallElement;
+  const TestNode: TCSSNode): TCSSSpecifity;
+var
+  CallID: TCSSNumericalID;
+begin
+  Result:=CSSSpecifityNoMatch;
+  CallID:=ResolveCall(aCall);
+  case CallID of
+  CSSCallID_NthChild:
+    Result:=Call_NthChild(aCall,TestNode);
+  else
+    Result:=CSSSpecifityInvalid;
+  end;
+end;
+
+function TCSSResolver.Call_NthChild(aCall: TCSSCallElement;
+  const TestNode: TCSSNode): TCSSSpecifity;
+var
+  i: Integer;
+begin
+  Result:=CSSSpecifityInvalid;
+  {$IFDEF VerboseCSSResolver}
+  writeln('TCSSResolver.Call_NthChild ',aCall.ArgCount);
+  for i:=0 to aCall.ArgCount-1 do
+    writeln('TCSSResolver.Call_NthChild ',i,' ',GetCSSObj(aCall.Args[i]),' AsString=',aCall.Args[i].AsString);
+  {$ENDIF}
+  DoError(20220914194913,'TCSSResolver.Call_NthChild',aCall);
+end;
+
 function TCSSResolver.ComputeValue(El: TCSSElement): TCSSString;
 var
   ElData: TObject;
@@ -729,23 +807,89 @@ begin
     begin
       StrEl:=TCSSStringElement(El);
       Result:=StrEl.Value;
+      {$IFDEF VerboseCSSResolver}
       writeln('TCSSResolver.ComputeValue String=[',Result,']');
+      {$ENDIF}
     end
     else if C=TCSSIntegerElement then
     begin
       IntEl:=TCSSIntegerElement(El);
       Result:=IntEl.AsString;
+      {$IFDEF VerboseCSSResolver}
+      writeln('TCSSResolver.ComputeValue Integer=[',Result,']');
+      {$ENDIF}
     end else if C=TCSSFloatElement then
     begin
       FloatEl:=TCSSFloatElement(El);
       Result:=FloatEl.AsString;
+      {$IFDEF VerboseCSSResolver}
+      writeln('TCSSResolver.ComputeValue Float=[',Result,']');
+      {$ENDIF}
     end;
-    writeln('TCSSResolver.ComputeValue Value="',Result,'"');
     AddElValueData(El,Result);
   end else
     DoError(20220910235106,'TCSSResolver.ComputeValue not supported',El);
 end;
 
+function TCSSResolver.SameValueText(const A, B: TCSSString): boolean;
+begin
+  if StringComparison=crscCaseInsensitive then
+    Result:=SameText(A,B)
+  else
+    Result:=A=B;
+end;
+
+function TCSSResolver.SameValueText(A: PChar; ALen: integer; B: PChar;
+  BLen: integer): boolean;
+var
+  AC, BC: Char;
+  i: Integer;
+begin
+  if ALen<>BLen then exit(false);
+  if ALen=0 then exit(true);
+  if StringComparison=crscCaseInsensitive then
+  begin
+    for i:=0 to ALen-1 do
+    begin
+      AC:=A^;
+      BC:=B^;
+      if (AC<>BC) and (UpCase(AC)<>UpCase(BC)) then
+        exit(false);
+      inc(A);
+      inc(B);
+    end;
+    Result:=true;
+  end else
+    Result:=CompareMem(A,B,ALen);
+end;
+
+function TCSSResolver.PosSubString(const SearchStr, Str: TCSSString): integer;
+var
+  SearchLen: SizeInt;
+  i: Integer;
+  SearchP, StrP: PChar;
+  AC, BC: Char;
+begin
+  if SearchStr='' then exit(0);
+  if Str='' then exit(0);
+  if StringComparison=crscCaseInsensitive then
+  begin
+    SearchP:=PChar(SearchStr);
+    StrP:=PChar(Str);
+    SearchLen:=length(SearchStr);
+    AC:=SearchP^;
+    for i:=0 to length(Str)-SearchLen do
+    begin
+      BC:=StrP^;
+      if (upcase(AC)=upcase(BC)) and SameValueText(SearchP,SearchLen,StrP,SearchLen) then
+        exit(i+1);
+      inc(StrP);
+    end;
+  end else begin
+    Result:=Pos(SearchStr,Str);
+  end;
+end;
+
 function TCSSResolver.PosWord(const SearchWord, Words: TCSSString): integer;
 // attribute selector ~=
 const
@@ -763,13 +907,14 @@ begin
     repeat
       if p>WordsLen then
         exit(0);
-      if not (Words[p] in Whitespace) then break;
+      if not (Words[p] in Whitespace) then
+        break;
       inc(p);
     until false;
     WordStart:=p;
     while (p<=WordsLen) and not (Words[p] in Whitespace) do
       inc(p);
-    if (p-WordStart=SearchLen) and CompareMem(@SearchWord[1],@Words[WordStart],SearchLen) then
+    if SameValueText(@SearchWord[1],SearchLen,@Words[WordStart],p-WordStart) then
       exit(WordStart);
   until p>WordsLen;
 end;
@@ -838,7 +983,7 @@ begin
     Result:=IdentData.NumericalID;
     {$IFDEF VerboseCSSResolver}
     if IdentData.Kind<>Kind then
-      DoError(20220908235300,'TCSSResolver.ResolveTypeIdentifier',El);
+      DoError(20220908235300,'TCSSResolver.ResolveIdentifier',El);
     {$ENDIF}
   end else
   begin
@@ -874,13 +1019,13 @@ begin
     end;
 
     // resolve user defined names
-    if Result=0 then
+    if Result=CSSIDNone then
       Result:=FNumericalIDs[Kind][aName];
 
     if Result=CSSIDNone then
     begin
       if croErrorOnUnknownName in FOptions then
-        DoError(20220908235919,'TCSSResolver.ResolveTypeIdentifier unknown '+CSSNumericalIDKindNames[Kind]+' "'+El.Name+'"',El);
+        DoError(20220908235919,'TCSSResolver.ResolveIdentifier unknown '+CSSNumericalIDKindNames[Kind]+' "'+El.Name+'"',El);
     end;
     IdentData:=TCSSIdentifierData.Create;
     IdentData.Kind:=Kind;
@@ -889,6 +1034,34 @@ begin
   end;
 end;
 
+function TCSSResolver.ResolveCall(El: TCSSCallElement): TCSSNumericalID;
+var
+  Data: TObject;
+  CallData: TCSSCallData;
+  aName: TCSSString;
+begin
+  Data:=El.CustomData;
+  if Data<>nil then
+  begin
+    CallData:=TCSSCallData(Data);
+    Result:=CallData.NumericalID;
+  end else
+  begin
+    aName:=El.Name;
+    Result:=CSSIDNone;
+
+    case aName of
+    ':nth-child': Result:=CSSCallID_NthChild;
+    else
+      if croErrorOnUnknownName in FOptions then
+        DoError(20220914193946,'TCSSResolver.ResolveCall unknown "'+El.Name+'"',El);
+    end;
+    CallData:=TCSSCallData.Create;
+    CallData.NumericalID:=Result;
+    AddElData(El,CallData);
+  end;
+end;
+
 procedure TCSSResolver.AddElData(El: TCSSElement; ElData: TCSSElResolverData);
 begin
   El.CustomData:=ElData;

packages/fcl-css/tests/tccssresolver.pp

@@ -213,8 +213,7 @@ type
     procedure Test_Selector_TypeTildeType; // general sibling combinator
     procedure Test_Selector_HasAttribute;
     procedure Test_Selector_AttributeEquals;
-    // ToDo: procedure Test_Selector_AttributeEqualsI;
-    // ToDo: procedure Test_Selector_AttributeEqualsS;
+    procedure Test_Selector_AttributeEqualsI;
     procedure Test_Selector_AttributeBeginsWith;
     procedure Test_Selector_AttributeEndsWith;
     procedure Test_Selector_AttributeBeginsWithHyphen;
@@ -228,7 +227,7 @@ type
     procedure Test_Selector_FirstChild;
     procedure Test_Selector_LastChild;
     procedure Test_Selector_OnlyChild;
-    // ToDo: :nth-child(n)
+    procedure Test_Selector_NthChild;
     // ToDo: :nth-last-child(n)
     procedure Test_Selector_FirstOfType;
     procedure Test_Selector_LastOfType;
@@ -533,6 +532,28 @@ begin
   AssertEquals('Button1.Width','5px',Button1.Width);
 end;
 
+procedure TTestCSSResolver.Test_Selector_AttributeEqualsI;
+var
+  Button1: TDemoButton;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Doc.Root.Left:='2px';
+
+  Button1:=TDemoButton.Create(Doc);
+  Button1.Parent:=Doc.Root;
+  Button1.Left:='3px';
+  Button1.Color:='maybe Black';
+
+  Doc.Style:=LinesToStr([
+  '[left="2Px" i] { top: 4px; }',
+  '[color="Maybe bLack" i] { width: 5px; }',
+  '']);
+  Doc.ApplyStyle;
+  AssertEquals('Root.Top','4px',Doc.Root.Top);
+  AssertEquals('Button1.Top','',Button1.Top);
+  AssertEquals('Button1.Width','5px',Button1.Width);
+end;
+
 procedure TTestCSSResolver.Test_Selector_AttributeBeginsWith;
 var
   Button1: TDemoButton;
@@ -737,7 +758,8 @@ end;
 
 procedure TTestCSSResolver.Test_Selector_LastChild;
 var
-  Div1, Div11, Div12, Div2: TDemoDiv;
+  Div1, Div11, Div2: TDemoDiv;
+  Button12: TDemoButton;
 begin
   Doc.Root:=TDemoNode.Create(nil);
 
@@ -747,8 +769,8 @@ begin
   Div11:=TDemoDiv.Create(Doc);
   Div11.Parent:=Div1;
 
-  Div12:=TDemoDiv.Create(Doc);
-  Div12.Parent:=Div1;
+  Button12:=TDemoButton.Create(Doc);
+  Button12.Parent:=Div1;
 
   Div2:=TDemoDiv.Create(Doc);
   Div2.Parent:=Doc.Root;
@@ -764,10 +786,10 @@ begin
   AssertEquals('Div1.Top','',Div1.Top);
   AssertEquals('Div11.Left','',Div11.Left);
   AssertEquals('Div11.Top','',Div11.Top);
-  AssertEquals('Div12.Left','6px',Div12.Left);
-  AssertEquals('Div12.Top','7px',Div12.Top);
+  AssertEquals('Button12.Left','6px',Button12.Left);
+  AssertEquals('Button12.Top','',Button12.Top);
   AssertEquals('Div2.Left','6px',Div2.Left);
-  AssertEquals('Div2.Top','',Div2.Top);
+  AssertEquals('Div2.Top','7px',Div2.Top);
 end;
 
 procedure TTestCSSResolver.Test_Selector_OnlyChild;
@@ -806,6 +828,44 @@ begin
   AssertEquals('Button12.Top','',Button12.Top);
 end;
 
+procedure TTestCSSResolver.Test_Selector_NthChild;
+var
+  Div1, Div2, Div3, Div4: TDemoDiv;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+
+  Div1:=TDemoDiv.Create(Doc);
+  Div1.Parent:=Doc.Root;
+
+  Div2:=TDemoDiv.Create(Doc);
+  Div2.Parent:=Doc.Root;
+
+  Div3:=TDemoDiv.Create(Doc);
+  Div3.Parent:=Doc.Root;
+
+  Div4:=TDemoDiv.Create(Doc);
+  Div4.Parent:=Doc.Root;
+
+  Doc.Style:=LinesToStr([
+  ':nth-child(2n+1) { left: 8px; }',
+  //':nth-child(even) { top: 3px; }',
+  //':nth-child(odd) { width: 4px; }',
+  //':nth-child(odd of .red) { height: 4px; }',
+  //':nth-child(even of :not([display=none])) { color: blue; }',
+  '']);
+  Doc.ApplyStyle;
+  AssertEquals('Root.Left','8px',Doc.Root.Left);
+  AssertEquals('Root.Top','',Doc.Root.Top);
+  AssertEquals('Div1.Left','8px',Div1.Left);
+  AssertEquals('Div1.Top','',Div1.Top);
+  AssertEquals('Div2.Left','',Div2.Left);
+  AssertEquals('Div2.Top','',Div2.Top);
+  AssertEquals('Div3.Left','8px',Div3.Left);
+  AssertEquals('Div3.Top','',Div3.Top);
+  AssertEquals('Div4.Left','8px',Div4.Left);
+  AssertEquals('Div4.Top','',Div4.Top);
+end;
+
 procedure TTestCSSResolver.Test_Selector_FirstOfType;
 var
   Div1, Div11, Div13, Div2: TDemoDiv;
@@ -915,7 +975,7 @@ begin
   AssertEquals('Root.Left','6px',Doc.Root.Left);
   AssertEquals('Root.Top','',Doc.Root.Top);
   AssertEquals('Div1.Left','',Div1.Left);
-  AssertEquals('Div1.Top','7px',Div1.Top);
+  AssertEquals('Div1.Top','',Div1.Top);
   AssertEquals('Div11.Left','6px',Div11.Left);
   AssertEquals('Div11.Top','7px',Div11.Top);
   AssertEquals('Button12.Left','6px',Button12.Left);
@@ -1292,7 +1352,7 @@ var
   i: Integer;
 begin
   i:=GetCSSIndex;
-  if (i<0) or (i+1>=NodeCount) then
+  if (i<0) or (i+1>=Parent.NodeCount) then
     Result:=nil
   else
     Result:=Parent.Nodes[i+1];
@@ -1321,15 +1381,21 @@ end;
 
 function TDemoNode.GetCSSNextOfType: TCSSNode;
 var
-  i: Integer;
+  i, Cnt: Integer;
   MyID: TCSSNumericalID;
+  aNode: TDemoNode;
 begin
-  i:=GetCSSIndex+1;
+  Result:=nil;
+  i:=GetCSSIndex;
+  if i<0 then exit;
+  inc(i);
   MyID:=CSSTypeID;
-  while i<NodeCount do
+  Cnt:=Parent.NodeCount;
+  while i<Cnt do
   begin
-    if Nodes[i].CSSTypeID=MyID then
-      exit(Nodes[i]);
+    aNode:=Parent.Nodes[i];
+    if aNode.CSSTypeID=MyID then
+      exit(aNode);
     inc(i);
   end;
 end;
@@ -1338,13 +1404,18 @@ function TDemoNode.GetCSSPreviousOfType: TCSSNode;
 var
   i: Integer;
   MyID: TCSSNumericalID;
+  aNode: TDemoNode;
 begin
-  i:=GetCSSIndex-1;
+  Result:=nil;
+  i:=GetCSSIndex;
+  if i<0 then exit;
+  dec(i);
   MyID:=CSSTypeID;
   while i>=0 do
   begin
-    if Nodes[i].CSSTypeID=MyID then
-      exit(Nodes[i]);
+    aNode:=Parent.Nodes[i];
+    if aNode.CSSTypeID=MyID then
+      exit(aNode);
     dec(i);
   end;
 end;