فهرست منبع

css: var and custom attributes

mattias 11 ماه پیش
والد
کامیت
16e1e67ece
4فایلهای تغییر یافته به همراه537 افزوده شده و 71 حذف شده
  1. 346 16
      src/base/fcl-css/fpcssresolver.pas
  2. 82 34
      src/base/fcl-css/fpcssresparser.pas
  3. 62 20
      src/base/fresnel.dom.pas
  4. 47 1
      tests/base/TCFresnelCSS.pas

+ 346 - 16
src/base/fcl-css/fpcssresolver.pas

@@ -169,6 +169,7 @@ type
     function GetCSSChild(const anIndex: integer): ICSSNode;
     function GetCSSNextOfType: ICSSNode;
     function GetCSSPreviousOfType: ICSSNode;
+    function GetCSSCustomAttribute(const AttrID: TCSSNumericalID): TCSSString;
     function HasCSSExplicitAttribute(const AttrID: TCSSNumericalID): boolean; // e.g. if the HTML has the attribute
     function GetCSSExplicitAttribute(const AttrID: TCSSNumericalID): TCSSString;
     function HasCSSPseudoClass(const AttrID: TCSSNumericalID): boolean;
@@ -178,6 +179,13 @@ type
 
 type
 
+  { TCSSResCustomAttributeDesc }
+
+  TCSSResCustomAttributeDesc = class(TCSSAttributeDesc)
+  public
+  end;
+  TCSSResCustomAttributeDescArray = array of TCSSResCustomAttributeDesc;
+
   { TCSSResolvedAttribute - used for shared rule lists, merged by the cascade algorithm, not yet computed  }
 
   TCSSResolvedAttribute = record
@@ -321,12 +329,13 @@ type
       end;
       TLayerArray = array of TLayer;
   private
+    FLayers: TLayerArray; // sorted for Origin, named layers before anonymous layers
     FOnLog: TCSSResolverLogEvent;
     FOptions: TCSSResolverOptions;
     FStringComparison: TCSSResStringComparison;
     FStyleSheets: TStyleSheets;
     FStyleSheetCount: integer;
-    FLayers: TLayerArray; // sorted for Origin, named layers before anonymous layers
+    function GetCustomAttributes(Index: TCSSNumericalID): TCSSAttributeDesc;
     function GetLogCount: integer;
     function GetLogEntries(Index: integer): TCSSResolverLogEntry;
     function GetStyleSheets(Index: integer): TStyleSheet;
@@ -348,6 +357,9 @@ type
       TMergedAttributeArray = array of TMergedAttribute;
 
   protected
+    FCustomAttributes: TCSSResCustomAttributeDescArray;
+    FCustomAttributeCount: TCSSNumericalID;
+    FCustomAttributeNameToDesc: TFPHashList;
     FElRules: TCSSSharedRuleArray;
     FElRuleCount: integer;
     FNode: ICSSNode;
@@ -359,11 +371,13 @@ type
     FMergedAllDecl: TCSSDeclarationElement;
     FMergedAllSpecifity: TCSSSpecifity;
     FSourceSpecifity: TCSSSpecifity;
+    FCSSRegistryStamp: TCSSNumericalID;
 
     // parse stylesheets
     procedure ParseSource(Index: integer); virtual;
     function ParseCSSSource(const Src: TCSSString; Inline: boolean): TCSSElement; virtual;
     procedure ClearElements; virtual;
+    procedure ClearCustomAttributes; virtual;
 
     // resolving rules
     procedure ComputeElement(El: TCSSElement); virtual;
@@ -404,6 +418,7 @@ type
 
     // merge properties
     procedure ClearMerge; virtual;
+    procedure InitMerge; virtual;
     procedure SetMergedAttribute(AttrID, aSpecifity: TCSSNumericalID; DeclEl: TCSSDeclarationElement);
     procedure RemoveMergedAttribute(AttrID: TCSSNumericalID);
     procedure MergeAttribute(El: TCSSElement; aSpecifity: TCSSSpecifity); virtual;
@@ -429,7 +444,11 @@ type
       out Rules: TCSSSharedRuleList {owned by resolver};
       out Values: TCSSAttributeValues
       ); virtual;
-    function GetAttributeDesc(AttrId: TCSSNumericalID): TCSSAttributeDesc; virtual;
+    // attributes
+    property CustomAttributes[Index: TCSSNumericalID]: TCSSAttributeDesc read GetCustomAttributes;
+    property CustomAttributeCount: TCSSNumericalID read FCustomAttributeCount;
+    function GetAttributeID(const aName: TCSSString; AutoCreate: boolean = false): TCSSNumericalID; override;
+    function GetAttributeDesc(AttrId: TCSSNumericalID): TCSSAttributeDesc; override;
     function GetDeclarationValue(Decl: TCSSDeclarationElement): TCSSString; virtual;
   public
     property Options: TCSSResolverOptions read FOptions write SetOptions;
@@ -765,6 +784,11 @@ begin
   Result:=FLogEntries.Count;
 end;
 
+function TCSSResolver.GetCustomAttributes(Index: TCSSNumericalID): TCSSAttributeDesc;
+begin
+  Result:=FCustomAttributes[Index];
+end;
+
 function TCSSResolver.GetLogEntries(Index: integer): TCSSResolverLogEntry;
 begin
   Result:=TCSSResolverLogEntry(FLogEntries[Index]);
@@ -851,13 +875,20 @@ begin
     exit;
   if CSSRegistry=nil then
     raise ECSSResolver.Create('20240630203634');
+
+  if (FCSSRegistryStamp>0) then
+  begin
+    if (FCSSRegistryStamp<>CSSRegistry.Stamp) then
+      raise ECSSResolver.Create('20240822143309 Clear was not called after changing CSSRegistry');
+  end else
+    FCSSRegistryStamp:=CSSRegistry.Stamp;
+
   aParser:=nil;
   ms:=TMemoryStream.Create;
   try
     ms.Write(Src[1],length(Src)*SizeOf(TCSSChar));
     ms.Position:=0;
     aParser:=TCSSResolverParser.Create(ms); // ss is freed by the parser
-    aParser.Registry:=CSSRegistry;
     aParser.Resolver:=Self;
     aParser.OnLog:=@Log;
     aParser.CSSNthChildParamsClass:=TCSSResolverNthChildParams;
@@ -879,6 +910,7 @@ begin
 
   ClearMerge;
   ClearSharedRuleLists;
+  ClearCustomAttributes;
 
   // clear layers
   for i:=0 to length(FLayers)-1 do
@@ -891,6 +923,19 @@ begin
 
   for i:=0 to FStyleSheetCount-1 do
     FreeAndNil(FStyleSheets[i].Element);
+
+  // not referencing CSSRegistry anymore
+  FCSSRegistryStamp:=0;
+end;
+
+procedure TCSSResolver.ClearCustomAttributes;
+var
+  i: Integer;
+begin
+  for i:=0 to FCustomAttributeCount-1 do
+    FreeAndNil(FCustomAttributes[i]);
+  FCustomAttributeCount:=0;
+  FCustomAttributeNameToDesc.Clear;
 end;
 
 procedure TCSSResolver.AddRule(aRule: TCSSRuleElement; Specifity: TCSSSpecifity
@@ -1043,6 +1088,25 @@ begin
   FMergedAttributeLast:=0;
 end;
 
+procedure TCSSResolver.InitMerge;
+var
+  OldLen, NewLen: TCSSNumericalID;
+begin
+  if FCustomAttributeCount>0 then
+  begin
+    if FCustomAttributes[0].Index<>CSSRegistry.AttributeCount then
+      raise ECSSResolver.Create('20240822142652');
+  end;
+
+  OldLen:=length(FMergedAttributes);
+  NewLen:=CSSRegistry.AttributeCount+FCustomAttributeCount;
+  if NewLen>OldLen then
+  begin
+    SetLength(FMergedAttributes,NewLen);
+    FillByte(FMergedAttributes[OldLen],(NewLen-OldLen)*SizeOf(TMergedAttribute),0);
+  end;
+end;
+
 procedure TCSSResolver.SetMergedAttribute(AttrID, aSpecifity: TCSSNumericalID;
   DeclEl: TCSSDeclarationElement);
 var
@@ -1050,6 +1114,8 @@ var
 begin
   if AttrID<=0 then
     raise ECSSResolver.Create('20240701120038');
+  if AttrID>=length(FMergedAttributes) then
+    raise ECSSResolver.Create('20240823095544');
 
   AttrP:=@FMergedAttributes[AttrID];
   AttrP^.Specifity:=aSpecifity;
@@ -2262,9 +2328,214 @@ end;
 procedure TCSSResolver.SubstituteVarCalls;
 // called after CSS attribute values have been merged by cascade rules
 // before replacing shorthands
+const
+  ReplaceMax = 10;
 var
   AttrID, NextAttrID: TCSSNumericalID;
   AttrP: PMergedAttribute;
+  p: PCSSChar;
+  ReplaceCnt: integer;
+
+  procedure SkipEscape;
+  begin
+    inc(p);
+    if p^>#0 then inc(p);
+  end;
+
+  procedure SkipString;
+  var
+    c: TCSSChar;
+  begin
+    c:=p^;
+    repeat
+      inc(p);
+      if p^=#0 then exit;
+      if p^=c then
+      begin
+        inc(p);
+        exit;
+      end;
+    until false;
+  end;
+
+  procedure SkipIdentifier;
+  begin
+    while p^ in ['-','_','a'..'z','A'..'Z'] do inc(p);
+  end;
+
+  procedure SkipWhiteSpace;
+  begin
+    while p^ in [' ',#9,#10,#13] do inc(p);
+  end;
+
+  function ReplaceVarsInRightString: boolean;
+  var
+    OldP, Lvl: integer;
+    VarStartP, NameStartP, NameEndP, ValueStartP, BracketCloseP: PCSSChar;
+    aValue, s: TCSSString;
+    VarName: ShortString;
+    Desc: TCSSResCustomAttributeDesc;
+    aParentNode: ICSSNode;
+  begin
+    {$IFDEF VerboseCSSVar}
+    writeln('ReplaceVarsInRightString p="',p,'"');
+    {$ENDIF}
+    Result:=true;
+    repeat
+      case p^ of
+      #0: break;
+      '"','''': SkipString;
+      '\': SkipEscape;
+      '@','#':
+        begin
+          inc(p);
+          SkipIdentifier;
+        end;
+      '-':
+        begin
+          inc(p);
+          if (p^ in ['a'..'z','A'..'Z','_','-']) then
+            SkipIdentifier;
+        end;
+      'a'..'z','A'..'Z','_':
+        if (p^='v') and (p[1]='a') and (p[2]='r') and (p[3]='(') then
+        begin
+          // var() found
+
+          inc(ReplaceCnt);
+          if ReplaceCnt=ReplaceMax then
+          begin
+            // maybe a loop
+            exit(false);
+          end;
+
+          VarStartP:=p;
+          inc(p,4);
+          SkipWhiteSpace;
+
+          // replace var() in parameter
+          OldP:=p-PCSSChar(AttrP^.Value);
+          if not ReplaceVarsInRightString then
+            exit(false);
+          p:=PCSSChar(AttrP^.Value)+OldP;
+
+          NameStartP:=p;
+          NameEndP:=nil;
+          ValueStartP:=nil;
+          if (p^<>'-') or (p[1]<>'-') then
+          begin
+            {$IFDEF VerboseCSSVar}
+            writeln('ReplaceVarsInRightString invalid VarName (must start with --): ',NameStartP);
+            {$ENDIF}
+            exit(false);
+          end;
+          inc(p,2);
+          while p^ in ['a'..'z','A'..'Z','_','-'] do inc(p);
+          NameEndP:=p;
+          if NameEndP-NameStartP>255 then
+          begin
+            {$IFDEF VerboseCSSVar}
+            writeln('ReplaceVarsInRightString invalid VarName (too long): ',NameStartP);
+            {$ENDIF}
+            exit(false);
+          end;
+          SkipWhiteSpace;
+          if p^=',' then
+          begin
+            inc(p);
+            SkipWhiteSpace;
+            ValueStartP:=p;
+          end;
+
+          // skip to round bracket close
+          Lvl:=1;
+          BracketCloseP:=nil;
+          repeat
+            case p^ of
+            #0:
+              begin
+                // syntax error
+                {$IFDEF VerboseCSSVar}
+                writeln('ReplaceVarsInRightString missing closing bracket: ',NameStartP);
+                {$ENDIF}
+                exit(false);
+              end;
+            '"','''': SkipString;
+            '\': SkipEscape;
+            '(':
+              begin
+                inc(Lvl);
+                inc(p);
+              end;
+            ')':
+              if Lvl=1 then
+              begin
+                BracketCloseP:=p;
+                inc(p);
+                break;
+              end else begin
+                dec(Lvl);
+                inc(p);
+              end;
+            else
+              inc(p);
+            end;
+          until false;
+
+          // fetch value from node
+          SetString(VarName,NameStartP,NameEndP-NameStartP);
+          Desc:=TCSSResCustomAttributeDesc(FCustomAttributeNameToDesc.Find(VarName));
+          if Desc<>nil then
+          begin
+            {$IFDEF VerboseCSSVar}
+            writeln('ReplaceVarsInRightString VarName="',VarName,'" AttrID=',Desc.Index);
+            {$ENDIF}
+            if FMergedAttributes[Desc.Index].Stamp=FMergedAttributesStamp then
+              aValue:=FMergedAttributes[Desc.Index].Value
+            else
+              aValue:='';
+            if aValue='' then
+            begin
+              aParentNode:=FNode.GetCSSParent;
+              if aParentNode<>nil then
+                aValue:=aParentNode.GetCSSCustomAttribute(Desc.Index);
+            end;
+          end else begin
+            {$IFDEF VerboseCSSVar}
+            writeln('ReplaceVarsInRightString VarName="',VarName,'" never declared');
+            {$ENDIF}
+            aValue:='';
+          end;
+
+          if aValue='' then
+          begin
+            // use default value
+            if ValueStartP<>nil then
+              SetString(aValue,ValueStartP,BracketCloseP-ValueStartP);
+          end;
+          {$IFDEF VerboseCSSVar}
+          writeln('ReplaceVarsInRightString VarName="',VarName,'" Value="',aValue,'"');
+          {$ENDIF}
+
+          // replace
+          p:=PCSSChar(AttrP^.Value);
+          OldP:=VarStartP-p;
+          s:=AttrP^.Value;
+          AttrP^.Value:=LeftStr(s,VarStartP-p)+aValue+copy(s,BracketCloseP-p+2,length(s));
+          {$IFDEF VerboseCSSVar}
+          writeln('ReplaceVarsInRightString New AttrP^.Value="',AttrP^.Value,'"');
+          {$ENDIF}
+
+          // continue parsing
+          p:=PCSSChar(AttrP^.Value)+OldP;
+        end else
+          SkipIdentifier;
+      else
+        inc(p);
+      end;
+    until false;
+  end;
+
 begin
   AttrID:=FMergedAttributeFirst;
   while AttrID>0 do
@@ -2273,9 +2544,19 @@ begin
     AttrP:=@FMergedAttributes[AttrID];
     if not AttrP^.Complete then
     begin
-      // todo: parse and search for var()
+      // check attribute
       if Pos('var(',AttrP^.Value)>0 then
-        raise ECSSResolver.Create('20240628164021');
+      begin
+        // can have var() calls -> parse
+        p:=PCSSChar(AttrP^.Value);
+        {$IFDEF VerboseCSSVar}
+        writeln('TCSSResolver.SubstituteVarCalls ',GetAttributeDesc(AttrID).Name,': "',AttrP^.Value,'"');
+        {$ENDIF}
+        ReplaceCnt:=0;
+        if not ReplaceVarsInRightString then
+          AttrP^.Value:='';
+      end;
+
       if AttrP^.Value='' then
         RemoveMergedAttribute(AttrID);
     end;
@@ -2485,11 +2766,13 @@ begin
   inherited;
   FLogEntries:=TFPObjectList.Create(true);
   FSharedRuleLists:=TAVLTree.Create(@CompareCSSSharedRuleLists);
+  FCustomAttributeNameToDesc:=TFPHashList.Create;
 end;
 
 destructor TCSSResolver.Destroy;
 begin
   Clear;
+  FreeAndNil(FCustomAttributeNameToDesc);
   FreeAndNil(FSharedRuleLists);
   FreeAndNil(FLogEntries);
   inherited Destroy;
@@ -2502,7 +2785,6 @@ end;
 
 procedure TCSSResolver.Init;
 var
-  OldLen, NewLen: TCSSNumericalID;
   i: Integer;
 begin
   if CSSRegistry.Modified then
@@ -2511,18 +2793,11 @@ begin
     CSSRegistry.Modified:=false;
   end;
 
+  // todo: if CSSRegistry has changed, reparse all stylesheets
+
   FMergedAttributesStamp:=1;
   for i:=0 to length(FMergedAttributes)-1 do
     FMergedAttributes[i].Stamp:=0;
-  OldLen:=length(FMergedAttributes);
-  NewLen:=OldLen;
-  if CSSRegistry.AttributeCount>NewLen then
-    NewLen:=CSSRegistry.AttributeCount;
-  if NewLen>OldLen then
-  begin
-    SetLength(FMergedAttributes,NewLen);
-    FillByte(FMergedAttributes[OldLen],(NewLen-OldLen)*SizeOf(TMergedAttribute),0);
-  end;
 end;
 
 procedure TCSSResolver.ClearSharedRuleLists;
@@ -2538,6 +2813,8 @@ begin
   Rules:=nil;
   FNode:=Node;
   try
+    InitMerge;
+
     FindMatchingRules;
 
     // create a shared rule list and merge attributes
@@ -2561,6 +2838,54 @@ begin
   end;
 end;
 
+function TCSSResolver.GetAttributeID(const aName: TCSSString; AutoCreate: boolean): TCSSNumericalID;
+var
+  Desc: TCSSResCustomAttributeDesc;
+  Cnt: TCSSNumericalID;
+begin
+  Result:=CSSRegistry.IndexOfAttributeName(aName);
+  if Result<0 then
+  begin
+    Desc:=TCSSResCustomAttributeDesc(FCustomAttributeNameToDesc.Find(aName));
+    if Desc<>nil then
+      exit(Desc.Index);
+
+    if AutoCreate
+        and (length(aName)>2) and (aName[1]='-') and (aName[2]='-')
+        and (length(aName)<256) then
+    begin
+      // create custom attribute
+      Cnt:=FCustomAttributeCount;
+      if Cnt=length(FCustomAttributes) then
+      begin
+        if Cnt<32 then
+          Cnt:=32
+        else
+          Cnt:=Cnt*2;
+        SetLength(FCustomAttributes,Cnt);
+        FillByte(FCustomAttributes[FCustomAttributeCount],SizeOf(Pointer)*(Cnt-FCustomAttributeCount),0);
+      end;
+
+      Desc:=TCSSResCustomAttributeDesc.Create;
+      Desc.Name:=aName;
+      Desc.Index:=CSSRegistry.AttributeCount+FCustomAttributeCount;
+      Desc.Inherits:=true;
+      FCustomAttributes[FCustomAttributeCount]:=Desc;
+      FCustomAttributeNameToDesc.Add(aName,Desc);
+
+      inc(FCustomAttributeCount);
+
+      Result:=Desc.Index;
+      Cnt:=GetAttributeID(aName);
+      if Cnt<>Result then
+        raise ECSSResolver.Create('20240822173412');
+
+      if GetAttributeDesc(Result)<>Desc then
+        raise ECSSResolver.Create('20240822174053');
+    end;
+  end;
+end;
+
 procedure TCSSResolver.FindMatchingRules;
 var
   aLayerIndex, i: Integer;
@@ -2587,7 +2912,12 @@ function TCSSResolver.GetAttributeDesc(AttrId: TCSSNumericalID
 begin
   Result:=nil;
   if AttrID<CSSRegistry.AttributeCount then
-    Result:=CSSRegistry.Attributes[AttrId];
+    Result:=CSSRegistry.Attributes[AttrId]
+  else begin
+    dec(AttrID,CSSRegistry.AttributeCount);
+    if AttrID<FCustomAttributeCount then
+      Result:=FCustomAttributes[AttrId];
+  end;
 end;
 
 function TCSSResolver.GetDeclarationValue(Decl: TCSSDeclarationElement): TCSSString;

+ 82 - 34
src/base/fcl-css/fpcssresparser.pas

@@ -30,7 +30,7 @@ interface
 {$IFDEF FPC_DOTTEDUNITS}
 uses
   System.Classes, System.SysUtils, System.Math, System.Contnrs, System.StrUtils,
-  Fcl.AVLTree, FPCss.Tree, FPCss.Scanner, FPCss.Parser;
+  Fcl.AVLTree, FpCss.Tree, FpCss.Scanner, FpCss.Parser;
 {$ELSE FPC_DOTTEDUNITS}
 uses
   Classes, SysUtils, Math, Contnrs, AVL_Tree, fpCSSTree, fpCSSScanner,
@@ -367,7 +367,7 @@ type
     FKeywordCount: TCSSNumericalID;
     FPseudoClassCount: TCSSNumericalID;
     FPseudoFunctionCount: TCSSNumericalID;
-    FStamp, FModifiedStamp: integer;
+    FStamp, FModifiedStamp: TCSSNumericalID;
     FTypeCount: TCSSNumericalID;
     function GetModified: boolean;
     procedure SetModified(const AValue: boolean);
@@ -379,7 +379,7 @@ type
     function IndexOfNamedItem(Kind: TCSSNumericalIDKind; const aName: TCSSString): TCSSNumericalID; overload;
     procedure ConsistencyCheck; virtual;
     procedure ChangeStamp;
-    property Stamp: integer read FStamp;
+    property Stamp: TCSSNumericalID read FStamp; // always >0
     property Modified: boolean read GetModified write SetModified;
   public
     // attributes
@@ -407,7 +407,7 @@ type
     function IndexOfPseudoClassName(const aName: TCSSString): TCSSNumericalID; overload;
     property PseudoClassCount: TCSSNumericalID read FPseudoClassCount;
   public
-    // pseudo functions
+    // pseudo functions lowercase (they are parsed case insensitive)
     PseudoFunctions: TCSSStringArray;
     function AddPseudoFunction(const aName: TCSSString): TCSSNumericalID; overload;
     function IndexOfPseudoFunction(const aName: TCSSString): TCSSNumericalID; overload;
@@ -435,7 +435,7 @@ type
   public
     // attribute functions
     AttrFunctions: TCSSStringArray;
-    const afVar = 1;
+    const afVar = CSSAttrFuncVar;
     function AddAttrFunction(const aName: TCSSString): TCSSNumericalID; overload;
     function IndexOfAttrFunction(const aName: TCSSString): TCSSNumericalID; overload;
     property AttrFunctionCount: TCSSNumericalID read FAttrFunctionCount;
@@ -564,6 +564,13 @@ type
     procedure SkipToEndOfAttribute(var p: PCSSChar);
     function SkipString(var p: PCSSChar): boolean;
     function SkipBrackets(var p: PCSSChar; Lvl: integer = 1): boolean;
+    // registry
+    function GetAttributeID(const aName: TCSSString; AutoCreate: boolean = false): TCSSNumericalID; virtual;
+    function GetAttributeDesc(AttrID: TCSSNumericalID): TCSSAttributeDesc; virtual;
+    function GetTypeID(const aName: TCSSString): TCSSNumericalID; virtual;
+    function GetPseudoClassID(const aName: TCSSString): TCSSNumericalID; virtual;
+    function GetPseudoFunctionID(const aName: TCSSString): TCSSNumericalID; virtual;
+
     property CSSRegistry: TCSSRegistry read FCSSRegistry write SetCSSRegistry;
   end;
 
@@ -574,10 +581,10 @@ type
   TCSSResolverParser = class(TCSSParser)
   private
     FOnLog: TCSSValueParserLogEvent;
-    FRegistry: TCSSRegistry;
     FResolver: TCSSBaseResolver;
   protected
-    function ResolveIdentifier(El: TCSSResolvedIdentifierElement; Kind: TCSSNumericalIDKind): TCSSNumericalID; virtual;
+    function ResolveAttribute(El: TCSSResolvedIdentifierElement): TCSSNumericalID; virtual;
+    function ResolveType(El: TCSSResolvedIdentifierElement): TCSSNumericalID; virtual;
     function ResolvePseudoClass(El: TCSSResolvedPseudoClassElement): TCSSNumericalID; virtual;
     function ResolvePseudoFunction(El: TCSSResolvedCallElement): TCSSNumericalID; virtual;
     function ParseCall(aName: TCSSString; IsSelector: boolean): TCSSCallElement; override;
@@ -597,7 +604,6 @@ type
     destructor Destroy; override;
     procedure Log(MsgType: TEventType; const ID: TCSSMsgID; const Msg: TCSSString; PosEl: TCSSElement); virtual;
     class function IsWhiteSpace(const s: TCSSString): boolean; virtual; overload;
-    property Registry: TCSSRegistry read FRegistry write FRegistry;
     property Resolver: TCSSBaseResolver read FResolver write FResolver;
     property OnLog: TCSSValueParserLogEvent read FOnLog write FOnLog;
   end;
@@ -1175,6 +1181,8 @@ begin
     raise ECSSParser.Create('missing name');
   if length(aName)>255 then
     raise ECSSParser.Create('pseudo function name too long');
+  if aName<>LowerCase(aName) then
+    raise ECSSParser.Create('pseudo function name not lowercase');
   Result:=IndexOfKeyword(aName);
   if Result>0 then
     raise ECSSParser.Create('duplicate pseudo function "'+aName+'"');
@@ -2054,30 +2062,68 @@ begin
   until false;
 end;
 
+function TCSSBaseResolver.GetAttributeID(const aName: TCSSString; AutoCreate: boolean
+  ): TCSSNumericalID;
+begin
+  Result:=CSSRegistry.IndexOfAttributeName(aName);
+  if AutoCreate then ;
+end;
+
+function TCSSBaseResolver.GetAttributeDesc(AttrID: TCSSNumericalID): TCSSAttributeDesc;
+begin
+  if (AttrID>0) and (AttrID<CSSRegistry.AttributeCount) then
+    Result:=CSSRegistry.Attributes[AttrID]
+  else
+    Result:=nil;
+end;
+
+function TCSSBaseResolver.GetTypeID(const aName: TCSSString): TCSSNumericalID;
+begin
+  Result:=CSSRegistry.IndexOfTypeName(aName);
+end;
+
+function TCSSBaseResolver.GetPseudoClassID(const aName: TCSSString): TCSSNumericalID;
+begin
+  Result:=CSSRegistry.IndexOfPseudoClassName(aName);
+end;
+
+function TCSSBaseResolver.GetPseudoFunctionID(const aName: TCSSString): TCSSNumericalID;
+begin
+  Result:=CSSRegistry.IndexOfPseudoFunction(aName);
+end;
+
 { TCSSResolverParser }
 
-function TCSSResolverParser.ResolveIdentifier(El: TCSSResolvedIdentifierElement;
-  Kind: TCSSNumericalIDKind): TCSSNumericalID;
+function TCSSResolverParser.ResolveAttribute(El: TCSSResolvedIdentifierElement): TCSSNumericalID;
 var
   aName: TCSSString;
 begin
   if El.NumericalID<>CSSIDNone then
     raise Exception.Create('20240701143234');
   aName:=El.Name;
-  if Kind=nikPseudoClass then
+  El.Kind:=nikAttribute;
+  Result:=Resolver.GetAttributeID(aName,true);
+  if Result<=CSSIDNone then
   begin
-    // pseudo classes are ASCII case insensitive
-    System.Delete(aName,1,1);
-    aName:=lowercase(aName);
-  end;
+    El.NumericalID:=-1;
+    Log(etWarning,20240822172823,'unknown attribute "'+aName+'"',El);
+  end else
+    El.NumericalID:=Result;
+end;
 
-  El.Kind:=Kind;
-  Result:=Registry.IndexOfNamedItem(Kind,aName);
-  //writeln('TCSSResolverParser.ResolveIdentifier ',aName,' ID=',Result);
-  if Result=CSSIDNone then
+function TCSSResolverParser.ResolveType(El: TCSSResolvedIdentifierElement): TCSSNumericalID;
+var
+  aName: TCSSString;
+begin
+  if El.NumericalID<>CSSIDNone then
+    raise Exception.Create('20240822133813');
+  aName:=El.Name;
+  El.Kind:=nikType;
+  Result:=Resolver.GetTypeID(aName);
+  if Result<=CSSIDNone then
   begin
     El.NumericalID:=-1;
-    Log(etWarning,20240625130648,'unknown '+CSSNumericalIDKindNames[Kind]+' "'+aName+'"',El);
+    Log(etWarning,20240822133816,'unknown type "'+aName+'"',El);
   end else
     El.NumericalID:=Result;
 end;
@@ -2096,12 +2142,12 @@ begin
     raise Exception.Create('20240701143234');
 
   El.Kind:=nikPseudoClass;
-  Result:=Registry.IndexOfNamedItem(nikPseudoClass,aName);
+  Result:=Resolver.GetPseudoClassID(aName);
   //writeln('TCSSResolverParser.ResolvePseudoClass ',aName,' ID=',Result);
   if Result<=CSSIDNone then
   begin
     El.NumericalID:=-1;
-    Log(etWarning,20240625130648,'unknown pseudo class "'+aName+'"',El);
+    Log(etWarning,20240822172826,'unknown pseudo class "'+aName+'"',El);
   end else
     El.NumericalID:=Result;
 end;
@@ -2122,12 +2168,12 @@ begin
   aName:=lowercase(aName);
 
   El.Kind:=nikPseudoFunction;
-  Result:=Registry.IndexOfNamedItem(nikPseudoFunction,aName);
+  Result:=Resolver.GetPseudoFunctionID(aName);
   //writeln('TCSSResolverParser.ResolvePseudoFunction ',aName,' ID=',Result);
-  if Result=CSSIDNone then
+  if Result<=CSSIDNone then
   begin
     El.NameNumericalID:=-1;
-    Log(etWarning,20240625130648,'unknown pseudo class "'+aName+'"',El);
+    Log(etWarning,20240822172830,'unknown pseudo function "'+aName+'"',El);
   end else
     El.NameNumericalID:=Result;
 end;
@@ -2175,8 +2221,7 @@ begin
   aKey:=Result.Keys[0];
   if aKey is TCSSResolvedIdentifierElement then
   begin
-    // todo: custom attributes
-    AttrId:=ResolveIdentifier(TCSSResolvedIdentifierElement(aKey),nikAttribute);
+    AttrId:=ResolveAttribute(TCSSResolvedIdentifierElement(aKey));
 
     if aKey.CustomData<>nil then
       raise Exception.Create('20240626113536');
@@ -2198,15 +2243,18 @@ begin
 
     if AttrId>=CSSAttributeID_All then
     begin
-      Desc:=Registry.Attributes[AttrId];
+      Desc:=Resolver.GetAttributeDesc(AttrId);
 
       if Pos('var(',AttrData.Value)>0 then
       begin
         // cannot be parsed yet
-      end else if Resolver.InitParseAttr(Desc,AttrData,AttrData.Value) then
+      end else if AttrID<Resolver.CSSRegistry.AttributeCount then
       begin
-        if Assigned(Desc.OnCheck) then
-          AttrData.Invalid:=not Desc.OnCheck(Resolver);
+        if Resolver.InitParseAttr(Desc,AttrData,AttrData.Value) then
+        begin
+          if Assigned(Desc.OnCheck) then
+            AttrData.Invalid:=not Desc.OnCheck(Resolver);
+        end;
       end;
       {$IFDEF VerboseCSSResolver}
       if AttrData.Invalid then
@@ -2231,7 +2279,7 @@ begin
   C:=El.ClassType;
   if C=TCSSResolvedIdentifierElement then
     // e.g. div {}
-    ResolveIdentifier(TCSSResolvedIdentifierElement(El),nikType)
+    ResolveType(TCSSResolvedIdentifierElement(El))
   else if C=TCSSHashIdentifierElement then
     // e.g. #id {}
   else if C=TCSSClassNameElement then
@@ -2303,7 +2351,7 @@ begin
   if C=TCSSResolvedIdentifierElement then
   begin
     // [name]  ->  has explicit attribute
-    ResolveIdentifier(TCSSResolvedIdentifierElement(El),nikAttribute);
+    ResolveAttribute(TCSSResolvedIdentifierElement(El));
   end else if C=TCSSBinaryElement then
     CheckSelectorArrayBinary(TCSSBinaryElement(El))
   else begin
@@ -2323,7 +2371,7 @@ begin
     Log(etWarning,20240625154314,'Invalid CSS array selector, expected attribute',Left);
     exit;
   end;
-  ResolveIdentifier(TCSSResolvedIdentifierElement(Left),nikAttribute);
+  ResolveAttribute(TCSSResolvedIdentifierElement(Left));
 
   Right:=aBinary.Right;
   C:=Right.ClassType;

+ 62 - 20
src/base/fresnel.dom.pas

@@ -833,6 +833,7 @@ type
     function GetCSSPreviousSibling: ICSSNode; virtual;
     function GetCSSTypeID: TCSSNumericalID; virtual;
     function GetCSSTypeName: TCSSString; virtual;
+    function GetCSSCustomAttribute(const AttrID: TCSSNumericalID): TCSSString; virtual;
     function HasCSSExplicitAttribute(const AttrID: TCSSNumericalID): boolean; virtual;
     function GetCSSExplicitAttribute(const AttrID: TCSSNumericalID): TCSSString; virtual;
     function HasCSSClass(const aClassName: TCSSString): boolean; virtual;
@@ -851,7 +852,8 @@ type
     function GetComputedFontSize: TFresnelLength; virtual;
     function GetComputedLength(Attr: TFresnelCSSAttribute; UseNaNOnFail: boolean = false): TFresnelLength; virtual; // on fail returns NaN
     function GetComputedString(Attr: TFresnelCSSAttribute): string; virtual;
-    function GetComputedCSSString(AttrID: TCSSNumericalID): string; virtual;
+    function GetComputedCSSString(AttrID: TCSSNumericalID): string; virtual; overload;
+    function GetComputedCSSString(const AttrName: string): string; overload;
     function GetComputedCSSShorthand(AttrID: TCSSNumericalID): string; virtual;
     function GetComputedBorderWidth(Attr: TFresnelCSSAttribute): TFresnelLength; virtual;
     function GetComputedBorderRadius(Corner: TFresnelCSSCorner): TFresnelPoint; virtual; // on fail returns 0
@@ -3516,24 +3518,28 @@ var
   Desc: TCSSAttributeDesc;
   Attr: TFresnelCSSAttribute;
 begin
-  Desc:=CSSRegistry.Attributes[AttrID];
-  if Desc is TFresnelCSSAttrDesc then
+  if AttrID<CSSRegistry.AttributeCount then
   begin
-    // some values of the viewport are fixed and cannot be overridden by CSS
-    Attr:=TFresnelCSSAttrDesc(Desc).Attr;
-    Complete:=true;
-    case Attr of
-    fcaDisplay: Result:='block flow-root';
-    fcaPosition: Result:='absolute';
-    fcaBoxSizing: Result:='content-box';
-    fcaZIndex: Result:='0';
-    fcaWidth: Result:=FloatToCSSStr(Width)+'px';
-    fcaHeight: Result:=FloatToCSSStr(Height)+'px';
-    else
-      Result:=inherited;
+    Desc:=CSSRegistry.Attributes[AttrID];
+    if Desc is TFresnelCSSAttrDesc then
+    begin
+      // some values of the viewport are fixed and cannot be overridden by CSS
+      Attr:=TFresnelCSSAttrDesc(Desc).Attr;
+      Complete:=true;
+      case Attr of
+      fcaDisplay: Result:='block flow-root';
+      fcaPosition: Result:='absolute';
+      fcaBoxSizing: Result:='content-box';
+      fcaZIndex: Result:='0';
+      fcaWidth: Result:=FloatToCSSStr(Width)+'px';
+      fcaHeight: Result:=FloatToCSSStr(Height)+'px';
+      else
+        Result:=inherited;
+      end;
+      exit;
     end;
-  end else
-    Result:=inherited;
+  end;
+  Result:=inherited;
 end;
 
 class function TFresnelViewport.CSSTypeID: TCSSNumericalID;
@@ -4179,7 +4185,9 @@ var
 begin
   Complete:=true;
 
-  AttrDesc:=CSSRegistry.Attributes[AttrID];
+  AttrDesc:=Resolver.GetAttributeDesc(AttrID);
+  if AttrDesc=nil then
+    exit('');
   if length(AttrDesc.CompProps)>0 then
   begin
     Result:=GetComputedCSSShorthand(AttrID);
@@ -4332,6 +4340,15 @@ begin
   if Complete then exit;
 end;
 
+function TFresnelElement.GetComputedCSSString(const AttrName: string): string;
+var
+  AttrID: TCSSNumericalID;
+begin
+  AttrID:=Resolver.GetAttributeID(AttrName);
+  if AttrID<=0 then exit('');
+  Result:=GetComputedCSSString(AttrID);
+end;
+
 function TFresnelElement.GetComputedCSSShorthand(AttrID: TCSSNumericalID): string;
 var
   AttrDesc, SubDesc: TCSSAttributeDesc;
@@ -4339,7 +4356,8 @@ var
   s: String;
 begin
   Result:='';
-  AttrDesc:=CSSRegistry.Attributes[AttrID];
+  AttrDesc:=Resolver.GetAttributeDesc(AttrID);
+  if AttrDesc=nil then exit;
   for i:=0 to length(AttrDesc.CompProps)-1 do
   begin
     SubDesc:=AttrDesc.CompProps[i];
@@ -5443,6 +5461,27 @@ begin
   Result:=CSSTypeName;
 end;
 
+function TFresnelElement.GetCSSCustomAttribute(const AttrID: TCSSNumericalID): TCSSString;
+var
+  El: TFresnelElement;
+  i: Integer;
+begin
+  Result:='';
+  El:=Self;
+  repeat
+    if El.FCSSValues<>nil then
+    begin
+      i:=El.FCSSValues.IndexOf(AttrID);
+      if i>=0 then
+      begin
+        Result:=El.FCSSValues.Values[i].Value;
+        if Result>'' then exit;
+      end;
+    end;
+    El:=El.Parent;
+  until El=nil;
+end;
+
 function TFresnelElement.HasCSSClass(const aClassName: TCSSString): boolean;
 var
   i: Integer;
@@ -5477,6 +5516,7 @@ var
   aComp: TCSSResCompValue;
   s: TCSSString;
   UseInherits, Complete: Boolean;
+  AttrID: TCSSNumericalID;
 begin
   Exclude(FStates,fesFontDescValid);
 
@@ -5491,7 +5531,9 @@ begin
     aValue:=FCSSValues.Values[i];
     if aValue.State<>cavsSource then continue;
     s:=aValue.Value;
-    AttrDesc:=CSSRegistry.Attributes[aValue.AttrID];
+    AttrID:=aValue.AttrID;
+    if AttrID>=CSSRegistry.AttributeCount then continue;
+    AttrDesc:=CSSRegistry.Attributes[AttrID];
     {$IFDEF VerboseCSSAttr}
     writeln('TFresnelElement.ComputeCSSValues ',Name,':',ClassName,' i=',i,'/',length(FCSSValues.Values),' ',AttrDesc.Name,': ',s,';');
     {$ENDIF}

+ 47 - 1
tests/base/TCFresnelCSS.pas

@@ -103,6 +103,7 @@ type
   published
     procedure TestEmptyViewport;
     procedure TestBody;
+
     procedure TestGetStyleAttr_OneValue;
     procedure TestGetStyleAttr_TwoValues;
     procedure TestGetStyleAttr_OneFunction;
@@ -120,8 +121,12 @@ type
     procedure TestSetStyleAttr_ReplaceFirstValue;
     procedure TestSetStyleAttr_ReplaceLastValue;
     procedure TestSetStyleAttr_ReplaceMiddleValue;
+
+    procedure TestVar_NoDefault;
   end;
 
+function LinesToStr(const Args: array of const): string;
+
 implementation
 
 const
@@ -241,6 +246,28 @@ begin
   Result:=Desc^.Compare(Font.Desc);
 end;
 
+function LinesToStr(const Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+  begin
+    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 += String(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += String(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding; // FPC uses encoding CP_UTF8 for TVarRec.VAnsiString
+      vtWidestring:   s += String(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += String(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  end;
+  Result:=s;
+end;
+
 { TTestFont }
 
 function TTestFont.GetFamily: string;
@@ -531,7 +558,6 @@ begin
   Body.Parent:=Viewport;
   Viewport.Draw;
   Body.WriteComputedAttributes('Body');
-
 end;
 
 procedure TTestFresnelCSS.TestGetStyleAttr_OneValue;
@@ -664,6 +690,26 @@ begin
   AssertEquals('padding-left:4px ; padding-top:7em; padding-right: 2px',Viewport.Style);
 end;
 
+procedure TTestFresnelCSS.TestVar_NoDefault;
+var
+  Body: TBody;
+begin
+  Viewport.Stylesheet.Text:=LinesToStr([
+    ':root {',
+    '--bird-color:red;',
+    '}',
+    'body {',
+    'color:var(--bird-color);',
+    '}']);
+  Body:=TBody.Create(Viewport);
+  Body.Name:='Body';
+  Body.Parent:=Viewport;
+  Viewport.ApplyCSS;
+  AssertEquals('red',Viewport.GetComputedCSSString('--bird-color'));
+  AssertEquals('red',Body.GetComputedCSSString('--bird-color'));
+  AssertEquals('red',Body.GetComputedCSSString('color'));
+end;
+
 Initialization
   RegisterTests([TTestFresnelCSS]);
 end.