fcl-css: started TCSSResolver

packages/fcl-css/src/fpcssresolver.pas

@@ -0,0 +1,520 @@
+{
+    This file is part of the Free Pascal Run time library.
+    Copyright (c) 2022 by Michael Van Canneyt ([email protected])
+
+    This file contains CSS utility class
+
+    See the File COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+ToDo:
+- TCSSResolver.FindComputedAttribute  use binary search for >8 elements
+
+}
+
+unit fpCSSResolver;
+
+{$mode ObjFPC}{$H+}
+{$Interfaces CORBA}
+
+interface
+
+uses
+  Classes, SysUtils, Contnrs, fpCSSTree;
+
+const
+  CSSSpecifityType = 1;
+  CSSSpecifityClass = 10; // includes attribute selectors [href]
+  CSSSpecifityIdentifier = 100;
+  CSSSpecifityInline = 1000;
+  CSSSpecifityImportant = 10000;
+
+  CSSIDNone = 0;
+  CSSTypeIDUniversal = 1; // id of type '*'
+  CSSAttributeIDAll = 1; // id of attribute key 'all'
+
+type
+  TCSSMsgID = int64;
+  TCSSNumericalID = integer;
+  TCSSSpecifity = integer;
+
+  ECSSResolver = class(Exception)
+  end;
+
+  { TCSSNode }
+
+  TCSSNode = interface
+    function GetCSSClassName: String;
+    function GetCSSTypeID: TCSSNumericalID;
+    function HasCSSClass(const aClassName: string): boolean;
+    procedure SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement);
+  end;
+
+type
+  TCSSNumericalIDKind = (
+    nikType,
+    nikAttribute,
+    nikPseudoAttribute
+    );
+  TCSSNumericalIDKinds = set of TCSSNumericalIDKind;
+
+const
+  CSSNumericalIDKindNames: array[TCSSNumericalIDKind] of string = (
+    'Type',
+    'Attribute',
+    'PseudoAttribute'
+    );
+
+type
+
+  { TCSSNumericalIDs }
+
+  TCSSNumericalIDs = class
+  private
+    FKind: TCSSNumericalIDKind;
+    fList: TFPHashList;
+    function GetIDs(const aName: string): TCSSNumericalID;
+    procedure SetIDs(const aName: string; 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 Kind: TCSSNumericalIDKind read FKind;
+  end;
+
+  TCSSComputedAttribute = record
+    AttrID: TCSSNumericalID;
+    Specifity: TCSSSpecifity;
+    Value: TCSSElement;
+  end;
+  TCSSComputedAttributeArray = array of TCSSComputedAttribute;
+  PCSSComputedAttribute = ^TCSSComputedAttribute;
+
+  TCSSIdentifierData = class
+  public
+    Identifier: TCSSIdentifierElement;
+    NumericalID: TCSSNumericalID;
+    Kind: TCSSNumericalIDKind;
+    Next, Prev: TCSSIdentifierData;
+  end;
+
+  TCSSResolverOption = (
+    roErrorOnUnknownName
+    );
+  TCSSResolverOptions = set of TCSSResolverOption;
+
+  TCSSComputeOption = (
+    ccoCommit
+    );
+  TCSSComputeOptions = set of TCSSComputeOption;
+
+const
+  DefaultCSSComputeOptions = [ccoCommit];
+
+type
+
+  { TCSSResolver }
+
+  TCSSResolver = class
+  private
+    FNumericalIDs: array[TCSSNumericalIDKind] of TCSSNumericalIDs;
+    FOptions: TCSSResolverOptions;
+    FStyle: TCSSElement;
+    FOwnsStyle: boolean;
+    FFirstIdentifierData: TCSSIdentifierData;
+    FLastIdentifierData: TCSSIdentifierData;
+    function GetAttributes(Index: integer): PCSSComputedAttribute;
+    function GetNumericalIDs(Kind: TCSSNumericalIDKind): TCSSNumericalIDs;
+    procedure SetNumericalIDs(Kind: TCSSNumericalIDKind;
+      const AValue: TCSSNumericalIDs);
+    procedure SetOptions(const AValue: TCSSResolverOptions);
+  protected
+    FAttributes: TCSSComputedAttributeArray;
+    FAttributeCount: integer;
+    FNode: TCSSNode;
+    procedure SetStyle(const AValue: TCSSElement); virtual;
+    procedure ComputeElement(El: TCSSElement); virtual;
+    procedure ComputeRule(aRule: TCSSRuleElement); virtual;
+    function SelectorMatches(aSelector: TCSSElement; 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;
+    function AddComputedAttribute(TheAttrID: TCSSNumericalID; aSpecifity: TCSSSpecifity;
+                          aValue: TCSSElement): PCSSComputedAttribute;
+    procedure DoError(const ID: TCSSMsgID; Msg: string; PosEl: TCSSElement); virtual;
+    function GetElPos(El: TCSSElement): string; virtual;
+    function GetElPath(El: TCSSElement): string; virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure ClearStyleCustomData; virtual;
+    procedure Compute(Node: TCSSNode; NodeStyle: TCSSElement = nil;
+      const CompOptions: TCSSComputeOptions = DefaultCSSComputeOptions); virtual;
+    procedure Commit; virtual;
+    property Style: TCSSElement read FStyle write SetStyle;
+    property OwnsStyle: boolean read FOwnsStyle write FOwnsStyle default false;
+    property NumericalIDs[Kind: TCSSNumericalIDKind]: TCSSNumericalIDs read GetNumericalIDs write SetNumericalIDs;
+    property Options: TCSSResolverOptions read FOptions write SetOptions;
+    property Attributes[Index: integer]: PCSSComputedAttribute read GetAttributes;
+    property AttributeCount: integer read FAttributeCount;
+  end;
+
+implementation
+
+{ TCSSNumericalIDs }
+
+function TCSSNumericalIDs.GetIDs(const aName: string): 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;
+  const AValue: TCSSNumericalID);
+var
+  i: Integer;
+begin
+  i:=fList.FindIndexOf(aName);
+  if i>=0 then
+    fList.Delete(i);
+  if AValue=CSSIDNone then
+    exit;
+  {$WARN 4056 off : Conversion between ordinals and pointers is not portable}
+  fList.Add(aName,Pointer(AValue));
+  {$WARN 4056 on}
+end;
+
+constructor TCSSNumericalIDs.Create(aKind: TCSSNumericalIDKind);
+begin
+  FKind:=aKind;
+  fList:=TFPHashList.Create;
+end;
+
+destructor TCSSNumericalIDs.Destroy;
+begin
+  FreeAndNil(fList);
+  inherited Destroy;
+end;
+
+procedure TCSSNumericalIDs.Clear;
+begin
+  fList.Clear;
+end;
+
+{ TCSSResolver }
+
+function TCSSResolver.GetNumericalIDs(Kind: TCSSNumericalIDKind
+  ): TCSSNumericalIDs;
+begin
+  Result:=FNumericalIDs[Kind];
+end;
+
+function TCSSResolver.GetAttributes(Index: integer): PCSSComputedAttribute;
+begin
+  if (Index<0) or (Index>=FAttributeCount) then
+    raise ECSSResolver.Create('TCSSResolver.GetAttributes index out of bounds');
+  Result:=@FAttributes[Index];
+end;
+
+procedure TCSSResolver.SetNumericalIDs(Kind: TCSSNumericalIDKind;
+  const AValue: TCSSNumericalIDs);
+begin
+  FNumericalIDs[Kind]:=AValue;
+end;
+
+procedure TCSSResolver.SetOptions(const AValue: TCSSResolverOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+end;
+
+procedure TCSSResolver.SetStyle(const AValue: TCSSElement);
+begin
+  if FStyle=AValue then Exit;
+  if FOwnsStyle then
+    FStyle.Free;
+  FStyle:=AValue;
+end;
+
+procedure TCSSResolver.ComputeElement(El: TCSSElement);
+var
+  C: TClass;
+  Compound: TCSSCompoundElement;
+  i: Integer;
+begin
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C=TCSSCompoundElement then
+  begin
+    Compound:=TCSSCompoundElement(El);
+    for i:=0 to Compound.ChildCount-1 do
+      ComputeElement(Compound.Children[i]);
+  end else if C=TCSSRuleElement then
+    ComputeRule(TCSSRuleElement(El))
+  else
+    DoError(20220908150252,'Unknown CSS element',El);
+end;
+
+procedure TCSSResolver.ComputeRule(aRule: TCSSRuleElement);
+var
+  i, j: Integer;
+  Specifity: TCSSSpecifity;
+  aSelector: TCSSElement;
+begin
+  for i:=0 to aRule.SelectorCount-1 do
+  begin
+    aSelector:=aRule.Selectors[i];
+    Specifity:=SelectorMatches(aSelector,FNode);
+    if Specifity<0 then continue;
+    // match -> apply properties
+    for j:=0 to aRule.ChildCount-1 do
+      MergeProperty(aRule.Children[j],Specifity);
+  end;
+end;
+
+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
+  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
+  begin
+    Identifier:=TCSSIdentifierElement(aSelector);
+    aClassName:=copy(Identifier.Name,2,255);
+    if TestNode.HasCSSClass(aClassName) then
+      Result:=CSSSpecifityClass;
+  end else
+    DoError(20220908230152,'Unknown CSS selector element',aSelector);
+end;
+
+procedure TCSSResolver.MergeProperty(El: TCSSElement; Specifity: TCSSSpecifity);
+var
+  C: TClass;
+  Decl: TCSSDeclarationElement;
+  aKey, aValue: TCSSElement;
+  AttrID: TCSSNumericalID;
+  CompAttr: PCSSComputedAttribute;
+begin
+  C:=El.ClassType;
+  if C=TCSSDeclarationElement then
+  begin
+    Decl:=TCSSDeclarationElement(El);
+    if Decl.KeyCount<>1 then
+      DoError(20220908232213,'Not yet implemented CSS declaration with KeyCount='+IntToStr(Decl.KeyCount),El);
+    if Decl.ChildCount<>1 then
+      DoError(20220908232324,'Not yet implemented CSS declaration with ChildCount='+IntToStr(Decl.ChildCount),El);
+
+    aKey:=Decl.Keys[0];
+    aValue:=Decl.Children[0];
+    if Decl.IsImportant then
+      Specifity:=CSSSpecifityImportant;
+
+    C:=aKey.ClassType;
+    if C=TCSSIdentifierElement then
+    begin
+      AttrID:=ResolveIdentifier(TCSSIdentifierElement(aKey),nikAttribute);
+      if AttrID=CSSIDNone then
+        DoError(20220909000932,'Unknown CSS property "'+TCSSIdentifierElement(aKey).Name+'"',aKey)
+      else if AttrID=CSSAttributeIDAll then
+        // 'all'
+        DoError(20220909001019,'Not yet implemented CSS property "'+TCSSIdentifierElement(aKey).Name+'"',aKey)
+      else begin
+        // set property
+        CompAttr:=FindComputedAttribute(AttrID);
+        if CompAttr<>nil then
+        begin
+          if CompAttr^.Specifity>Specifity then
+            exit;
+          CompAttr^.Specifity:=Specifity;
+          CompAttr^.Value:=aValue;
+        end else begin
+          AddComputedAttribute(AttrID,Specifity,aValue);
+        end;
+      end;
+    end else
+      DoError(20220908232359,'Unknown CSS key',aKey);
+  end else
+    DoError(20220908230855,'Unknown CSS property',El);
+end;
+
+function TCSSResolver.ResolveIdentifier(El: TCSSIdentifierElement;
+  Kind: TCSSNumericalIDKind): TCSSNumericalID;
+var
+  Data: TObject;
+  IdentData: TCSSIdentifierData;
+begin
+  Data:=El.CustomData;
+  if Data<>nil then
+  begin
+    IdentData:=TCSSIdentifierData(Data);
+    Result:=IdentData.NumericalID;
+    {$IFDEF VerboseCSSResolver}
+    if IdentData.Kind<>Kind then
+      DoError(20220908235300,'TCSSResolver.ResolveTypeIdentifier',El);
+    {$ENDIF}
+  end else
+  begin
+    Result:=FNumericalIDs[Kind][El.Name];
+    if Result=CSSIDNone then
+    begin
+      if roErrorOnUnknownName in FOptions then
+        DoError(20220908235919,'TCSSResolver.ResolveTypeIdentifier unknown '+CSSNumericalIDKindNames[Kind]+' "'+El.Name+'"',El);
+    end;
+    IdentData:=TCSSIdentifierData.Create;
+    El.CustomData:=IdentData;
+    IdentData.Identifier:=El;
+    IdentData.Kind:=Kind;
+    IdentData.NumericalID:=Result;
+    if FFirstIdentifierData=nil then
+    begin
+      FFirstIdentifierData:=IdentData;
+    end else begin
+      FLastIdentifierData.Next:=IdentData;
+      IdentData:=FLastIdentifierData;
+    end;
+    FLastIdentifierData:=IdentData;
+  end;
+end;
+
+function TCSSResolver.FindComputedAttribute(AttrID: TCSSNumericalID
+  ): PCSSComputedAttribute;
+var
+  i: Integer;
+begin
+  for i:=0 to FAttributeCount-1 do
+    if FAttributes[i].AttrID=AttrID then
+      exit(@FAttributes[i]);
+  Result:=nil;
+end;
+
+function TCSSResolver.AddComputedAttribute(TheAttrID: TCSSNumericalID;
+  aSpecifity: TCSSSpecifity; aValue: TCSSElement): PCSSComputedAttribute;
+var
+  NewLength: Integer;
+begin
+  if FAttributeCount=length(FAttributes) then
+  begin
+    NewLength:=FAttributeCount*2;
+    if NewLength<16 then
+      NewLength:=16;
+    SetLength(FAttributes,NewLength);
+  end;
+  with FAttributes[FAttributeCount] do
+  begin
+    AttrID:=TheAttrID;
+    Specifity:=aSpecifity;
+    Value:=aValue;
+  end;
+  Result:=@FAttributes[FAttributeCount];
+  inc(FAttributeCount);
+end;
+
+procedure TCSSResolver.DoError(const ID: TCSSMsgID; Msg: string;
+  PosEl: TCSSElement);
+begin
+  Msg:='['+IntToStr(ID)+'] '+Msg+' at '+GetElPos(PosEl);
+  raise ECSSResolver.Create(Msg);
+end;
+
+function TCSSResolver.GetElPos(El: TCSSElement): string;
+begin
+  if El=nil then
+    Result:='no element'
+  else begin
+    Result:=El.SourceFileName+'('+IntToStr(El.SourceCol)+','+IntToStr(El.SourceCol)+')';
+    {$IFDEF VerboseCSSResolver}
+    Result:='['+GetElPath(El)+']'+Result;
+    {$ENDIF}
+  end;
+end;
+
+function TCSSResolver.GetElPath(El: TCSSElement): string;
+begin
+  Result:=GetCSSPath(El);
+end;
+
+constructor TCSSResolver.Create;
+begin
+
+end;
+
+destructor TCSSResolver.Destroy;
+begin
+  if FOwnsStyle then
+    FStyle.Free;
+  FStyle:=nil;
+  inherited Destroy;
+end;
+
+procedure TCSSResolver.ClearStyleCustomData;
+var
+  Data: TCSSIdentifierData;
+begin
+  while FLastIdentifierData<>nil do
+  begin
+    Data:=FLastIdentifierData;
+    FLastIdentifierData:=Data.Prev;
+    if FLastIdentifierData<>nil then
+      FLastIdentifierData.Next:=nil
+    else
+      FFirstIdentifierData:=nil;
+    if Data.Identifier.CustomData<>Data then
+      DoError(20220908234726,'TCSSResolver.ClearStyleCustomData',Data.Identifier);
+    Data.Identifier.CustomData:=nil;
+    Data.Free;
+  end;
+end;
+
+procedure TCSSResolver.Compute(Node: TCSSNode; NodeStyle: TCSSElement;
+  const CompOptions: TCSSComputeOptions);
+begin
+  FNode:=Node;
+  try
+    FAttributeCount:=0;
+    ComputeElement(Style);
+    ComputeElement(NodeStyle);
+    if ccoCommit in CompOptions then
+      Commit;
+  finally
+    FNode:=nil;
+  end;
+end;
+
+procedure TCSSResolver.Commit;
+var
+  i: Integer;
+begin
+  for i:=0 to FAttributeCount-1 do
+    with FAttributes[i] do
+      FNode.SetCSSValue(AttrID,Value);
+end;
+
+end.
+

packages/fcl-css/tests/tccssparser.pp

@@ -839,7 +839,6 @@ function TTestBaseCSSParser.CheckLiteral(Msg: String; aEl: TCSSelement; aValue:
 begin
   Result:=TCSSIntegerElement(CheckClass(Msg+': Class', TCSSIntegerElement,aEl));
   AssertEquals(Msg+': Value ',aValue,Result.Value);
-
 end;
 
 function TTestBaseCSSParser.CheckLiteral(Msg: String; aEl: TCSSelement; aValue: Integer; AUnits: TCSSUnits): TCSSIntegerElement;
@@ -854,7 +853,6 @@ begin
   AssertTrue('Have argument '+IntToStr(aIndex),aIndex<aCall.ChildCount);
   Result:=aCall.Children[0];
   AssertNotNull('Have call argument',Result);
-
 end;
  
 initialization

packages/fcl-css/tests/tccssresolver.pp

@@ -0,0 +1,506 @@
+{
+    This file is part of the Free Pascal Run time library.
+    Copyright (c) 2022 by Michael Van Canneyt ([email protected])
+
+    This file contains the tests for the CSS parser
+
+    See the File COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit tcCSSResolver;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Contnrs, fpcunit, testregistry, fpCSSParser, fpCSSTree,
+  fpCSSResolver;
+
+type
+  TDemoNodeAttribute = (
+    naLeft,
+    naTop,
+    naWidth,
+    naHeight,
+    naBorder,
+    naDisplay,
+    naColor
+    );
+  TDemoNodeAttributes = set of TDemoNodeAttribute;
+
+const
+  DemoAttributeNames: array[TDemoNodeAttribute] of string = (
+    // case sensitive!
+    'left',
+    'top',
+    'width',
+    'height',
+    'border',
+    'display',
+    'color'
+    );
+
+  DemoAttrIDBase = 100;
+
+type
+  TDemoPseudoClass = (
+    pcActive,
+    pcHover
+    );
+  TDemoPseudoClasses = set of TDemoPseudoClass;
+
+type
+
+  { TDemoNode }
+
+  TDemoNode = class(TComponent,TCSSNode)
+  private
+    class var FAttributeInitialValues: array[TDemoNodeAttribute] of string;
+  private
+    FAttributeValues: array[TDemoNodeAttribute] of string;
+    FNodes: TFPObjectList; // list of TDemoNode
+    FCSSClasses: TStrings;
+    FID: string;
+    FParent: TDemoNode;
+    FStyleElements: TCSSElement;
+    FStyle: string;
+    function GetAttribute(AIndex: TDemoNodeAttribute): string;
+    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);
+  protected
+    procedure Notification(AComponent: TComponent; Operation: TOperation);
+      override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Clear;
+    class function CSSClassName: string; virtual;
+    function GetCSSClassName: string;
+    class function CSSTypeID: TCSSNumericalID; virtual;
+    function GetCSSTypeID: TCSSNumericalID;
+    class function GetAttributeInitialValue(Attr: TDemoNodeAttribute): string; virtual;
+    function HasCSSClass(const aClassName: string): boolean; virtual;
+    procedure SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement); virtual;
+    property ID: string read FID write SetID;
+    property Parent: TDemoNode read FParent write SetParent;
+    property NodeCount: integer read GetNodeCount;
+    property Nodes[Index: integer]: TDemoNode read GetNodes; default;
+    property CSSClasses: TStrings read FCSSClasses;
+    property StyleElements: TCSSElement read FStyleElements write SetStyleElements;
+    property Style: string read FStyle write SetStyle;
+    // CSS attributes
+    property Left: string index naLeft read GetAttribute write SetAttribute;
+    property Top: string index naTop read GetAttribute write SetAttribute;
+    property Width: string index naWidth read GetAttribute write SetAttribute;
+    property Height: string index naHeight read GetAttribute write SetAttribute;
+    property Border: string index naBorder read GetAttribute write SetAttribute;
+    property Display: string index naDisplay read GetAttribute write SetAttribute;
+    property Color: string index naColor read GetAttribute write SetAttribute;
+    property Attribute[Attr: TDemoNodeAttribute]: string read GetAttribute write SetAttribute;
+  end;
+
+  { TDemoButton }
+
+  TDemoButton = class(TDemoNode)
+  public
+    class function CSSClassName: string; override;
+    class function CSSTypeID: TCSSNumericalID; override;
+  end;
+
+  { TDemoDocument }
+
+  TDemoDocument = class(TComponent)
+  private
+    FNumericalIDs: array[TCSSNumericalIDKind] of TCSSNumericalIDs;
+    FCSSResolver: TCSSResolver;
+    FStyle: string;
+    FStyleElements: TCSSElement;
+    function GetNumericalIDs(Kind: TCSSNumericalIDKind): TCSSNumericalIDs;
+    procedure SetNumericalIDs(Kind: TCSSNumericalIDKind;
+      const AValue: TCSSNumericalIDs);
+    procedure SetStyle(const AValue: string);
+    procedure SetStyleElements(const AValue: TCSSElement);
+  public
+    Root: TDemoNode;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure ApplyStyle; virtual;
+    procedure ApplyStyleToNode(Node: TDemoNode); virtual;
+
+    property NumericalIDs[Kind: TCSSNumericalIDKind]: TCSSNumericalIDs read GetNumericalIDs write SetNumericalIDs;
+
+    property StyleElements: TCSSElement read FStyleElements write SetStyleElements;
+    property Style: string read FStyle write SetStyle;
+
+    property CSSResolver: TCSSResolver read FCSSResolver;
+  end;
+
+  { TCustomTestCSSResolver }
+
+  TCustomTestCSSResolver = class(TTestCase)
+  Private
+    FDoc: TDemoDocument;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  public
+    property Doc: TDemoDocument read FDoc;
+  end;
+
+  { TTestCSSResolver }
+
+  TTestCSSResolver = class(TCustomTestCSSResolver)
+  published
+    procedure Test_Universal;
+  end;
+
+function LinesToStr(Args: array of const): string;
+
+implementation
+
+function LinesToStr(Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtChar:         s += Args[i].VChar+LineEnding;
+      vtString:       s += Args[i].VString^+LineEnding;
+      vtPChar:        s += Args[i].VPChar+LineEnding;
+      vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
+      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  Result:=s;
+end;
+
+{ TCustomTestCSSResolver }
+
+procedure TCustomTestCSSResolver.SetUp;
+begin
+  inherited SetUp;
+  FDoc:=TDemoDocument.Create(nil);
+end;
+
+procedure TCustomTestCSSResolver.TearDown;
+begin
+  FreeAndNil(FDoc);
+  inherited TearDown;
+end;
+
+{ TTestCSSResolver }
+
+procedure TTestCSSResolver.Test_Universal;
+begin
+  Doc.Root:=TDemoNode.Create(nil);
+  Doc.Style:='* { left: 10px; }';
+  Doc.ApplyStyle;
+  AssertEquals('left','10px',Doc.Root.Left);
+end;
+
+{ TDemoButton }
+
+class function TDemoButton.CSSClassName: string;
+begin
+  Result:='button';
+end;
+
+class function TDemoButton.CSSTypeID: TCSSNumericalID;
+begin
+  Result:=101;
+end;
+
+{ TDemoDocument }
+
+procedure TDemoDocument.SetStyle(const AValue: string);
+var
+  ss: TStringStream;
+  aParser: TCSSParser;
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  FreeAndNil(FStyleElements);
+  aParser:=nil;
+  ss:=TStringStream.Create(Style);
+  try
+    aParser:=TCSSParser.Create(ss);
+    FStyleElements:=aParser.Parse;
+  finally
+    aParser.Free;
+  end;
+end;
+
+function TDemoDocument.GetNumericalIDs(Kind: TCSSNumericalIDKind
+  ): TCSSNumericalIDs;
+begin
+  Result:=FNumericalIDs[Kind];
+end;
+
+procedure TDemoDocument.SetNumericalIDs(Kind: TCSSNumericalIDKind;
+  const AValue: TCSSNumericalIDs);
+begin
+  FNumericalIDs[Kind]:=AValue;
+end;
+
+procedure TDemoDocument.SetStyleElements(const AValue: TCSSElement);
+begin
+  if FStyleElements=AValue then Exit;
+  FStyleElements.Free;
+  FStyleElements:=AValue;
+end;
+
+constructor TDemoDocument.Create(AOwner: TComponent);
+var
+  Attr: TDemoNodeAttribute;
+  TypeIDs, AttributeIDs: TCSSNumericalIDs;
+  NumKind: TCSSNumericalIDKind;
+begin
+  inherited Create(AOwner);
+
+  for NumKind in TCSSNumericalIDKind do
+    FNumericalIDs[NumKind]:=TCSSNumericalIDs.Create(NumKind);
+  TypeIDs:=FNumericalIDs[nikType];
+  TypeIDs['*']:=CSSTypeIDUniversal;
+  if TypeIDs['*']<>CSSTypeIDUniversal then
+    raise Exception.Create('20220909004740');
+
+  TypeIDs[TDemoNode.CSSClassName]:=TDemoNode.CSSTypeID;
+  TypeIDs[TDemoButton.CSSClassName]:=TDemoButton.CSSTypeID;
+
+  AttributeIDs:=FNumericalIDs[nikAttribute];
+  AttributeIDs['all']:=CSSAttributeIDAll;
+  for Attr in TDemoNodeAttribute do
+    AttributeIDs[DemoAttributeNames[Attr]]:=ord(Attr)+DemoAttrIDBase;
+
+  FCSSResolver:=TCSSResolver.Create;
+  for NumKind in TCSSNumericalIDKind do
+    CSSResolver.NumericalIDs[NumKind]:=FNumericalIDs[NumKind];
+
+  Root:=TDemoNode.Create(Self);
+  Root.Name:='Root';
+end;
+
+destructor TDemoDocument.Destroy;
+var
+  NumKind: TCSSNumericalIDKind;
+begin
+  FreeAndNil(FCSSResolver);
+  FreeAndNil(Root);
+  FreeAndNil(FStyleElements);
+  for NumKind in TCSSNumericalIDKind do
+    FreeAndNil(FNumericalIDs[NumKind]);
+  inherited Destroy;
+end;
+
+procedure TDemoDocument.ApplyStyle;
+
+  procedure Traverse(Node: TDemoNode);
+  var
+    i: Integer;
+  begin
+    ApplyStyleToNode(Node);
+    for i:=0 to Node.NodeCount-1 do
+      Traverse(Node[i]);
+  end;
+
+begin
+  CSSResolver.Style:=StyleElements;
+  Traverse(Root);
+end;
+
+procedure TDemoDocument.ApplyStyleToNode(Node: TDemoNode);
+begin
+  CSSResolver.Compute(Node,Node.StyleElements);
+end;
+
+{ TDemoNode }
+
+function TDemoNode.GetAttribute(AIndex: TDemoNodeAttribute): string;
+begin
+  Result:=FAttributeValues[AIndex];
+end;
+
+function TDemoNode.GetNodeCount: integer;
+begin
+  Result:=FNodes.Count;
+end;
+
+function TDemoNode.GetNodes(Index: integer): TDemoNode;
+begin
+  Result:=TDemoNode(FNodes[Index]);
+end;
+
+procedure TDemoNode.SetAttribute(AIndex: TDemoNodeAttribute;
+  const AValue: string);
+begin
+  if FAttributeValues[AIndex]=AValue then exit;
+  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;
+  if AValue=Self then
+    raise Exception.Create('cycle');
+
+  if FParent<>nil then
+  begin
+    FParent.FNodes.Remove(Self);
+  end;
+  FParent:=AValue;
+  if FParent<>nil then
+  begin
+    FParent.FNodes.Add(Self);
+    FreeNotification(FParent);
+  end;
+end;
+
+procedure TDemoNode.SetStyleElements(const AValue: TCSSElement);
+begin
+  if FStyleElements=AValue then Exit;
+  FreeAndNil(FStyleElements);
+  FStyleElements:=AValue;
+end;
+
+procedure TDemoNode.SetStyle(const AValue: string);
+var
+  ss: TStringStream;
+  aParser: TCSSParser;
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  FreeAndNil(FStyleElements);
+  aParser:=nil;
+  ss:=TStringStream.Create(Style);
+  try
+    aParser:=TCSSParser.Create(ss);
+    FStyleElements:=aParser.Parse;
+  finally
+    aParser.Free;
+  end;
+end;
+
+procedure TDemoNode.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if AComponent=Self then exit;
+  if Operation=opRemove then
+  begin
+    if FNodes<>nil then
+      FNodes.Remove(AComponent);
+  end;
+end;
+
+constructor TDemoNode.Create(AOwner: TComponent);
+var
+  a: TDemoNodeAttribute;
+begin
+  inherited Create(AOwner);
+  FNodes:=TFPObjectList.Create(false);
+  FCSSClasses:=TStringList.Create;
+  for a in TDemoNodeAttribute do
+    FAttributeValues[a]:=FAttributeInitialValues[a];
+end;
+
+destructor TDemoNode.Destroy;
+begin
+  Clear;
+  FreeAndNil(FNodes);
+  FreeAndNil(FCSSClasses);
+  inherited Destroy;
+end;
+
+procedure TDemoNode.Clear;
+var
+  i: Integer;
+begin
+  FCSSClasses.Clear;
+  for i:=NodeCount-1 downto 0 do
+    Nodes[i].Parent:=nil;
+  FNodes.Clear;
+end;
+
+class function TDemoNode.CSSClassName: string;
+begin
+  Result:='node';
+end;
+
+class function TDemoNode.GetAttributeInitialValue(Attr: TDemoNodeAttribute
+  ): string;
+begin
+  case Attr of
+    naLeft: Result:='0px';
+    naTop: Result:='0px';
+    naWidth: Result:='';
+    naHeight: Result:='';
+    naBorder: Result:='1px';
+    naDisplay: Result:='inline';
+    naColor: Result:='#000';
+  end;
+end;
+
+function TDemoNode.HasCSSClass(const aClassName: string): boolean;
+var
+  i: Integer;
+begin
+  for i:=0 to CSSClasses.Count-1 do
+    if aClassName=CSSClasses[i] then
+      exit(true);
+  Result:=false;
+end;
+
+procedure TDemoNode.SetCSSValue(AttrID: TCSSNumericalID; Value: TCSSElement);
+var
+  Attr: TDemoNodeAttribute;
+  s: TCSSString;
+begin
+  if (AttrID<DemoAttrIDBase) or (AttrID>ord(High(TDemoNodeAttribute))+DemoAttrIDBase) then
+    raise Exception.Create('TDemoNode.SetCSSValue invalid AttrID '+IntToStr(AttrID));
+  Attr:=TDemoNodeAttribute(AttrID-DemoAttrIDBase);
+  s:=Value.AsString;
+  {$IFDEF VerboseCSSResolver}
+  writeln('TDemoNode.SetCSSValue ',DemoAttributeNames[Attr],':="',s,'"');
+  {$ENDIF}
+  Attribute[Attr]:=s;
+end;
+
+function TDemoNode.GetCSSClassName: string;
+begin
+  Result:=CSSClassName;
+end;
+
+class function TDemoNode.CSSTypeID: TCSSNumericalID;
+begin
+  Result:=100;
+end;
+
+function TDemoNode.GetCSSTypeID: TCSSNumericalID;
+begin
+  Result:=CSSTypeID;
+end;
+
+initialization
+  RegisterTests([TTestCSSResolver]);
+end.
+

packages/fcl-css/tests/testcss.lpi

@@ -7,7 +7,6 @@
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="testcss"/>
@@ -29,6 +28,11 @@
         <Filename Value="testcss.lpr"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="tccssresolver.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcCSSResolver"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -42,9 +46,9 @@
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Other>
-      <CustomOptions Value="-dVerboseCSSParser"/>
-      <OtherDefines Count="1">
+      <OtherDefines Count="2">
         <Define0 Value="VerboseCSSParser"/>
+        <Define1 Value="VerboseCSSResolver"/>
       </OtherDefines>
     </Other>
   </CompilerOptions>

packages/fcl-css/tests/testcss.lpr

@@ -3,7 +3,8 @@ program testcss;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, sysutils, consoletestrunner, tcCSSScanner, tcCSSParser, tcCSSTree;
+  Classes, sysutils, consoletestrunner, tcCSSScanner, tcCSSParser, tcCSSTree,
+  tcCSSResolver;
 
 type