* Allow extended chars, fix nested at rules. Fix issue #39638

packages/fcl-css/examples/extractcssclasses.lpr

@@ -17,7 +17,7 @@ program extractcssclasses;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, SysUtils, CustApp, fpcssutils, fpcsstree;
+  Classes, SysUtils, CustApp, fpcssScanner, fpcssutils, fpcsstree;
 
 type
 
@@ -52,6 +52,8 @@ begin
     L.Options:=L.Options-[soTrailingLineBreak];
     if (aOutput<>'') and FileExists(aOutput) then
       L.LoadFromFile(aOutput);
+    if HasOption('x','extended') then
+      Util.ExtraScannerOptions:=[csoExtendedIdentifiers];
     Util.ExtractClassNames(aFileName,L);
     if aOutput='' then
       begin
@@ -69,8 +71,8 @@ end;
 procedure TCSSClassNamesApplication.DoRun;
 
 Const
-  Opts = 'ho::';
-  LongOpts : Array of string = ('help','output::');
+  Opts = 'ho::x';
+  LongOpts : Array of string = ('help','output::','extended');
 
 var
   FN, FNOutput : String;
@@ -112,6 +114,7 @@ begin
   Writeln('where options is one or more of:');
   Writeln('-h --help           This help message');
   Writeln('-o --output=FILE    Write class names to this file.');
+  Writeln('-x --extended       Allow non-standard identifiers.');
   exitCode:=Ord(aError<>'');
 end;
 

packages/fcl-css/src/fpcssparser.pp

@@ -16,7 +16,7 @@ unit fpCSSParser;
 
 { $mode ObjFPC}{$H+}
 
-{ $DEFINE debugparser}
+{$DEFINE debugparser}
 
 interface
 
@@ -37,6 +37,7 @@ Type
     FPeekToken : TCSSToken;
     FPeekTokenString : UTF8String;
     FFreeScanner : Boolean;
+    FRuleLevel : Integer;
     function CreateElement(aClass: TCSSElementClass): TCSSElement;
     class function GetAppendElement(aList: TCSSListElement): TCSSElement;
     function GetAtEOF: Boolean;
@@ -72,7 +73,7 @@ Type
     Property CurrentLine : Integer Read GetCurLine;
     Property CurrentPos : Integer Read GetCurPos;
   Public
-    Constructor Create(AInput: TStream);
+    Constructor Create(AInput: TStream; ExtraScannerOptions : TCSSScannerOptions = []);
     Constructor Create(AScanner : TCSSScanner); virtual;
     Destructor Destroy; override;
     Function Parse : TCSSElement;
@@ -194,10 +195,11 @@ begin
     Result:=0;
 end;
 
-constructor TCSSParser.Create(AInput: TStream);
+constructor TCSSParser.Create(AInput: TStream; ExtraScannerOptions : TCSSScannerOptions = []);
 begin
   FInput:=AInput;
   Create(TCSSScanner.Create(FInput));
+  FScanner.Options:=FScanner.Options+ExtraScannerOptions;
   FFreeScanner:=True;
 end;
 
@@ -237,9 +239,16 @@ Var
   Term : TCSSTokens;
   aLast : TCSSToken;
   aList : TCSSListElement;
+  {$ifdef debugparser}
+  aAt : String;
+  {$endif}
 
 begin
-//  Writeln('Parse rule. IsAt:',IsAt);
+  Inc(FRuleLevel);
+{$ifdef debugparser}
+  aAt:=Format(' Level %d at (%d:%d)',[FRuleLevel,CurrentLine,CurrentPos]);
+  Writeln('Parse @ rule');
+{$endif}
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
   aRule:=TCSSAtRuleElement(CreateElement(TCSSAtRuleElement));
   TCSSAtRuleElement(aRule).AtKeyWord:=CurrentTokenString;
@@ -266,6 +275,8 @@ begin
       Consume(ctkRBRACE);
       end;
     Result:=aRule;
+{$ifdef debugparser}  Writeln('Done Parse @ rule ',aAt); {$endif}
+    Inc(FRuleLevel);
   except
     aRule.Free;
     Raise;
@@ -503,12 +514,12 @@ end;
 function TCSSParser.ParsePseudo: TCSSElement;
 
 Var
-  aPseudo : TCSSClassNameElement;
+  aPseudo : TCSSPseudoClassElement;
   aValue : string;
 
 begin
   aValue:=CurrentTokenString;
-  aPseudo:=TCSSClassNameElement(CreateElement(TCSSClassNameElement));
+  aPseudo:=TCSSPseudoClassElement(CreateElement(TCSSPseudoClassElement));
   try
     Consume(ctkPseudo);
     aPseudo.Value:=aValue;
@@ -522,25 +533,33 @@ end;
 function TCSSParser.ParseRuleBody(aRule: TCSSRuleElement; aIsAt: Boolean = false): integer;
 
 Var
-  aDecl : TCSSDeclarationElement;
+  aDecl : TCSSElement;
+
+  Function CheckColon : Boolean;
+  begin
+    Result:=(aDecl is TCSSDeclarationElement);
+    if Result then
+      Result:=TCSSDeclarationElement(aDecl).Colon;
+  end;
 
 begin
   if not (CurrentToken in [ctkRBRACE,ctkSEMICOLON]) then
     begin
-    aDecl:=ParseDeclaration(aIsAt) as TCSSDeclarationElement;
-    if Assigned(aDecl) then
-      aRule.AddChild(aDecl);
+    aDecl:=ParseDeclaration(aIsAt);
+    aRule.AddChild(aDecl);
     end;
   While Not (CurrentToken in [ctkEOF,ctkRBRACE]) do
     begin
-    if aDecl.Colon then
+    if CheckColon then
       While CurrentToken=ctkSEMICOLON do
         Consume(ctkSEMICOLON);
     if Not (CurrentToken in [ctkEOF,ctkRBRACE]) then
       begin
-      aDecl:=ParseDeclaration(aIsAt);
-      if Assigned(aDecl) then
-        aRule.AddChild(aDecl);
+      if CurrentToken=ctkATKEYWORD then
+        aDecl:=ParseAtRule
+      else
+        aDecl:=ParseDeclaration(aIsAt);
+      aRule.AddChild(aDecl);
       end;
     end;
   Result:=aRule.ChildCount;
@@ -554,9 +573,16 @@ Var
   Term : TCSSTokens;
   aLast : TCSSToken;
   aList: TCSSListElement;
+{$IFDEF debugparser}
+  aAt : String;
+{$ENDIF}
 
 begin
-//  Writeln('Parse rule. IsAt:',IsAt);
+  Inc(FRuleLevel);
+{$IFDEF debugparser}
+  aAt:=Format(' Level %d at (%d:%d)',[FRuleLevel,CurrentLine,CurrentPos]);
+  Writeln('Parse rule. IsAt: ',IsAt,aAt);
+{$ENDIF}
   Term:=[ctkLBRACE,ctkEOF,ctkSEMICOLON];
   if IsAt then
     begin
@@ -585,10 +611,13 @@ begin
       begin
       Consume(ctkLBrace);
       ParseRuleBody(aRule,IsAt);
-      // Writeln('Parsed rule');
       Consume(ctkRBRACE);
       end;
     Result:=aRule;
+    {$IFDEF debugparser}
+    Writeln('Rule started at ',aAt,' done');
+    {$endif}
+    Dec(FRuleLevel);
   except
     aRule.Free;
     Raise;

packages/fcl-css/src/fpcssscanner.pp

@@ -111,12 +111,13 @@ Type
 
   { TCSSScanner }
 
+  TCSSScannerOption = (csoExtendedIdentifiers,csoReturnComments,csoReturnWhiteSpace);
+  TCSSScannerOptions = set of TCSSScannerOption;
 
   TCSSScanner = class
   private
     FDisablePseudo: Boolean;
-    FReturnComments: Boolean;
-    FReturnWhiteSpace: Boolean;
+    FOptions: TCSSScannerOptions;
     FSourceFile: TLineReader;
     FSourceFilename: UTF8String;
     FCurRow: Integer;
@@ -138,7 +139,12 @@ Type
     Function DoUnicodeRange : TCSSTOKEN;
     function FetchLine: Boolean;
     function GetCurColumn: Integer;
+    function GetReturnComments: Boolean;
+    function GetReturnWhiteSpace: Boolean;
     function ReadUnicodeEscape: WideChar;
+    procedure SetReturnComments(AValue: Boolean);
+    procedure SetReturnWhiteSpace(AValue: Boolean);
+    class function UnknownCharToStr(C: Char): String;
   protected
     procedure DoError(const Msg: UTF8String; Args: array of const); overload;
     procedure DoError(const Msg: UTF8String); overload;
@@ -149,8 +155,9 @@ Type
     destructor Destroy; override;
     procedure OpenFile(const AFilename: UTF8String);
     Function FetchToken: TCSSToken;
-    Property ReturnComments : Boolean Read FReturnComments Write FReturnComments;
-    Property ReturnWhiteSpace : Boolean Read FReturnWhiteSpace Write FReturnWhiteSpace;
+    Property ReturnComments : Boolean Read GetReturnComments Write SetReturnComments;
+    Property ReturnWhiteSpace : Boolean Read GetReturnWhiteSpace Write SetReturnWhiteSpace;
+    Property Options : TCSSScannerOptions Read FOptions Write FOptions;
     property SourceFile: TLineReader read FSourceFile;
     property CurFilename: UTF8String read FSourceFilename;
     property CurLine: UTF8String read FCurLine;
@@ -358,6 +365,22 @@ begin
   Result:=WideChar(StrToInt('$'+S));
 end;
 
+procedure TCSSScanner.SetReturnComments(AValue: Boolean);
+begin
+  if AValue then
+    Include(FOptions,csoReturnComments)
+  else
+    Exclude(FOptions,csoReturnComments)
+end;
+
+procedure TCSSScanner.SetReturnWhiteSpace(AValue: Boolean);
+begin
+  if AValue then
+    Include(FOptions,csoReturnWhiteSpace)
+  else
+    Exclude(FOptions,csoReturnWhiteSpace)
+end;
+
 
 function TCSSScanner.DoStringLiteral: TCSSToken;
 
@@ -421,26 +444,33 @@ function TCSSScanner.DoNumericLiteral :TCSSToken;
 Var
   TokenStart : PChar;
   Len : Integer;
+  isEscape : Boolean;
 
 begin
   Result := ctkINTEGER;
+  isEscape:=TokenStr[0]='\';
+  if IsEscape then
+    Inc(TokenStr);
   TokenStart := TokenStr;
   while true do
     begin
     Inc(TokenStr);
     case TokenStr[0] of
       '.':
-        begin
-          Result := ctkFLOAT;
-          if TokenStr[1] in ['0'..'9'] then
+        if IsEscape then
+          Break
+        else
           begin
-            Inc(TokenStr);
-            repeat
+            Result := ctkFLOAT;
+            if TokenStr[1] in ['0'..'9'] then
+            begin
               Inc(TokenStr);
-            until not (TokenStr[0] in ['0'..'9']);
+              repeat
+                Inc(TokenStr);
+              until not (TokenStr[0] in ['0'..'9']);
+            end;
+            break;
           end;
-          break;
-        end;
       '0'..'9': ;
       else
         break;
@@ -450,6 +480,12 @@ begin
   Setlength(FCurTokenString, Len);
   if (Len>0) then
   Move(TokenStart^,FCurTokenString[1],Len);
+  if IsEscape then
+    begin
+    result:=ctkString;
+    FCurTokenString:=Char(StrToInt(FCurTokenString));
+    end;
+
 end;
 
 function TCSSScanner.DoHash :TCSSToken;
@@ -525,12 +561,23 @@ begin
 
 end;
 
+Class Function TCSSScanner.UnknownCharToStr(C: Char) : String;
+
+begin
+  if C=#0 then
+    Result:='EOF'
+  else if (C in WhiteSpace) then
+    Result:='#'+IntToStr(Ord(C))
+  else
+    Result:='"'+C+'"';
+end;
+
 function TCSSScanner.DoIdentifierLike : TCSSToken;
 
 Var
   TokenStart:PChar;
-  Len : Integer;
-  IsAt, IsPseudo, IsFunc : Boolean;
+  Len,oLen : Integer;
+  IsEscape,IsAt, IsPseudo, IsFunc : Boolean;
 
 
 begin
@@ -544,20 +591,33 @@ begin
       IsPseudo:=True;
       Inc(TokenStr);
       end;
-  repeat
-    Inc(TokenStr);
-    //If (TokenStr[0]='\') and (TokenStr[1]='u') then
-  until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_','-','$']);
-  if not IsAt then
-    begin
-    IsFunc:=TokenStr[0]='(';
-    if IsFunc then
-      Inc(TokenStr);
-    end;
-  Len:=(TokenStr-TokenStart);
-  SetLength(FCurTokenString,Len);
-  if Len > 0 then
-    Move(TokenStart^,FCurTokenString[1],Len);
+  Repeat
+    if not (TokenStr[0]='\') then
+      repeat
+        Inc(TokenStr);
+        //If (TokenStr[0]='\') and (TokenStr[1]='u') then
+      until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_','-','$']);
+    IsEscape:=TokenStr[0]='\';
+    if IsEscape then
+      begin
+      if ((TokenStr[0] in WhiteSpace) or (TokenStr[0]=#0))  then
+        DoError(SErrUnknownCharacter ,[UnknownCharToStr(TokenStr[0])])
+      end
+    else if not IsAt then
+      begin
+      IsFunc:=TokenStr[0]='(';
+      if IsFunc then
+        Inc(TokenStr);
+      end;
+    Len:=(TokenStr-TokenStart);
+    oLen:=Length(FCurTokenString);
+    SetLength(FCurTokenString,Olen+Len);
+    if Len > 0 then
+      Move(TokenStart^,FCurTokenString[Olen+1],Len);
+     if IsEscape then
+       Inc(TokenStr);
+     TokenStart := TokenStr;
+  until Not IsEscape;
   // Some specials
   if (CurTokenString[1]='.') and not IsFunc then
     Result:=ctkCLASSNAME
@@ -643,23 +703,27 @@ begin
        Result:=DoHash;
     '\':
        begin
-       if TokenStr[0] in ['0'..'9'] then
+       if TokenStr[1] in ['0'..'9'] then
          Result:=DoNumericLiteral
        else
          begin
-         Inc(TokenStr);
-         if TokenStr[0]=#0 then
-           Result:=ctkEOF
+         if (TokenStr[1] in WhiteSpace) or (TokenStr[1]=#0) then
+           DoError(SErrUnknownCharacter ,[UnknownCharToStr(TokenStr[1])])
          else
-           CharToken(ctkSTRING);
+           Result:=DoIdentifierLike
          end;
        end;
     '0'..'9':
        Result:=DoNumericLiteral;
     '&': CharToken(ctkAnd);
-    '{': CharToken(ctkLBRACE);
+    '{': CharToken( ctkLBRACE);
     '}': CharToken(ctkRBRACE);
-    '*': CharToken(ctkSTAR);
+    '*': if Not (csoExtendedIdentifiers in Options) then
+           CharToken(ctkSTAR)
+         else if TokenStr[1] in AlNumIden then
+           Result:=DoIdentifierLike
+         else
+           CharToken(ctkSTAR);
     '^': CharToken(ctkSQUARED);
     ',': CharToken(ctkCOMMA);
     '~': CharToken(ctkTILDE);
@@ -747,6 +811,16 @@ begin
     Result := TokenStr - PChar(CurLine);
 end;
 
+function TCSSScanner.GetReturnComments: Boolean;
+begin
+  Result:=(csoReturnComments in FOptions);
+end;
+
+function TCSSScanner.GetReturnWhiteSpace: Boolean;
+begin
+  Result:=(csoReturnWhiteSpace in FOptions);
+end;
+
 { TStreamLineReader }
 
 constructor TStreamLineReader.Create(AStream: TStream);

packages/fcl-css/src/fpcsstree.pp

@@ -206,20 +206,19 @@ Type
   { TCSSClassNameElement }
 
   TCSSClassNameElement = Class(TCSSIdentifierElement)
+  Protected
+    function GetAsString(aFormat : Boolean; const aIndent : String): UTF8String; override;
   Public
     Class function CSSType : TCSSType; override;
   end;
 
   { TCSSPseudoClassElement }
 
-  TCSSPseudoClassElement = Class(TCSSElement)
-  private
-    FElement: TCSSElement;
-    procedure SetElement(AValue: TCSSElement);
+  TCSSPseudoClassElement = Class(TCSSIdentifierElement)
+  Protected
+    function GetAsString(aFormat : Boolean; const aIndent : String): UTF8String; override;
   Public
     Class function CSSType : TCSSType; override;
-    Destructor Destroy; override;
-    Property Element : TCSSElement Read FElement Write SetElement;
   end;
 
 
@@ -341,7 +340,10 @@ Type
 
 
 
+// Convert unicode codepoints to \0000 notation
 Function StringToCSSString(S : UTF8String) : UTF8String;
+// Escapes non-identifier characters C to \C
+Function StringToIdentifier(S : UTF8String) : UTF8String;
 
 Const
   CSSUnitNames : Array[TCSSUnits] of string =
@@ -429,6 +431,32 @@ begin
   Result:='"'+Result+'"';
 end;
 
+function StringToIdentifier(S: UTF8String): UTF8String;
+
+Var
+  iIn,iOut : Integer;
+  C : Char;
+
+begin
+  Result:='';
+  SetLength(Result,2*Length(S));
+  iIn:=1;
+  iOut:=0;
+  While iIn<=Length(S) do
+    begin
+    C:=S[iIn];
+    If Not (C in ['a'..'z','A'..'Z','_','-']) then
+      begin
+      inc(iOut);
+      Result[iOut]:='\';
+      end;
+    inc(iOut);
+    Result[iOut]:=C;
+    Inc(iIn);
+    end;
+  SetLength(Result,iOut);
+end;
+
 { TCSSListElement }
 
 function TCSSListElement.GetAsString(aFormat: Boolean; const aIndent: String): UTF8String;
@@ -720,11 +748,17 @@ end;
 
 { TCSSPseudoClassElement }
 
-procedure TCSSPseudoClassElement.SetElement(AValue: TCSSElement);
+function TCSSPseudoClassElement.GetAsString(aFormat: Boolean; const aIndent: String): UTF8String;
+
+Var
+  I : Integer;
+
 begin
-  if FElement=AValue then Exit;
-  FreeAndNil(FElement);
-  FElement:=AValue;
+  I:=1;
+  if (Length(Value)>2) and (Value[2]=':') then
+    I:=2;
+  Writeln('Value ',Value, ' -> ',I);
+  Result:=Copy(Value,1,I)+StringToIdentifier(Copy(Value,I+1,Length(Value)-I));
 end;
 
 class function TCSSPseudoClassElement.CSSType: TCSSType;
@@ -732,12 +766,6 @@ begin
   Result:=csstPSEUDOCLASS;
 end;
 
-destructor TCSSPseudoClassElement.Destroy;
-begin
-  Element:=Nil;
-  inherited Destroy;
-end;
-
 { TCSSChildrenElement }
 
 function TCSSChildrenElement.GetChild(aIndex : Integer): TCSSElement;
@@ -870,6 +898,11 @@ end;
 
 { TCSSClassNameElement }
 
+function TCSSClassNameElement.GetAsString(aFormat: Boolean; const aIndent: String): UTF8String;
+begin
+  Result:=Copy(Value,1,1)+StringToIdentifier(Copy(Value,2,Length(Value)-1));
+end;
+
 class function TCSSClassNameElement.CSSType: TCSSType;
 begin
   Result:=csstCLASSNAME;
@@ -884,7 +917,7 @@ end;
 
 function TCSSIdentifierElement.GetAsString(aFormat : Boolean; const aIndent : String): UTF8String;
 begin
-  Result:=Value;
+  Result:=StringToIdentifier(Value);
 end;
 
 class function TCSSIdentifierElement.CSSType: TCSSType;

packages/fcl-css/src/fpcssutils.pp

@@ -38,6 +38,9 @@ Type
   { TCSSUtils }
 
   TCSSUtils = class(TComponent)
+  private
+    FExtraScannerOptions: TCSSScannerOptions;
+  published
     Procedure ExtractClassNames(Const aFileName : String; aList : TStrings);
     Procedure ExtractClassNames(Const aStream : TStream; aList : TStrings);
     Procedure ExtractClassNames(Const aElement : TCSSElement; aList : TStrings);
@@ -45,6 +48,7 @@ Type
     Function ExtractClassNames(Const aStream : TStream) : TStringDynArray;
     Function ExtractClassNames(Const aElement : TCSSElement) : TStringDynArray;
     Procedure Minimize(aInput,aOutput : TStream);
+    Property ExtraScannerOptions : TCSSScannerOptions Read FExtraScannerOptions Write FExtraScannerOptions;
   end;
 
 implementation
@@ -102,7 +106,7 @@ Var
 
 begin
   aElement:=Nil;
-  aParser:=TCSSParser.Create(aStream);
+  aParser:=TCSSParser.Create(aStream,ExtraScannerOptions);
   try
     aElement:=aParser.Parse;
     ExtractClassNames(aElement,aList);

packages/fcl-css/tests/tccssparser.pp

@@ -418,14 +418,14 @@ end;
 procedure TTestCSSParser.TestPseudoPrefixedEmptyRule;
 var
   R : TCSSRuleElement;
-  Sel : TCSSClassNameElement;
+  Sel : TCSSPseudoClassElement;
 
 begin
   ParseRule(':a { }');
   R:=TCSSRuleElement(CheckClass('Rule',TCSSRuleElement,FirstRule));
   AssertEquals('No rule children',0,R.ChildCount);
   AssertEquals('selector count',1,R.SelectorCount);
-  sel:=TCSSClassNameElement(CheckClass('Selector', TCSSClassNameElement,R.Selectors[0]));
+  sel:=TCSSPseudoClassElement(CheckClass('Selector', TCSSPseudoClassElement,R.Selectors[0]));
   AssertEquals('Pseudo name',':a',sel.Value);
 end;
 

packages/fcl-css/tests/tccssscanner.pp

@@ -73,9 +73,11 @@ type
     Procedure TestComment2;
     Procedure TestComment3;
     Procedure TestID1;
-    Procedure TestID2;
-    Procedure TestID3;
-    Procedure TestID4;
+    Procedure TestIDUnderscore;
+    Procedure TestIDMinus;
+    Procedure TestIDMinusMinus;
+    Procedure TestIDEscape;
+    Procedure TestIDEscapeStart;
     procedure TestPSEUDO;
     procedure TestPSEUDO2;
     procedure TestPSEUDOMinus;
@@ -296,21 +298,31 @@ begin
   CheckToken(ctkIDENTIFIER,'anid');
 end;
 
-procedure TTestCSSScanner.TestID2;
+procedure TTestCSSScanner.TestIDUnderscore;
 begin
   CheckToken(ctkIDENTIFIER,'_anid');
 end;
 
-procedure TTestCSSScanner.TestID3;
+procedure TTestCSSScanner.TestIDMinus;
 begin
   CheckToken(ctkIDENTIFIER,'-anid');
 end;
 
-procedure TTestCSSScanner.TestID4;
+procedure TTestCSSScanner.TestIDMinusMinus;
 begin
   CheckToken(ctkIDENTIFIER,'--anid');
 end;
 
+procedure TTestCSSScanner.TestIDEscape;
+begin
+  CheckToken(ctkIDENTIFIER,'an\(id');
+end;
+
+procedure TTestCSSScanner.TestIDEscapeStart;
+begin
+  CheckToken(ctkIDENTIFIER,'\(anid');
+end;
+
 
 procedure TTestCSSScanner.TestSEMI;
 begin

packages/fcl-css/tests/tccsstree.pp

@@ -396,9 +396,9 @@ end;
 
 procedure TCSSTreeAsStringTest.TestPSEUDOCLASS;
 begin
-  TCSSClassNameElement(CreateElement(TCSSClassNameElement)).Value:=':abc';
+  TCSSPseudoClassElement(CreateElement(TCSSPseudoClassElement)).Value:=':abc';
   AssertEquals('Value',':abc',Element.AsString);
-  TCSSClassNameElement(CreateElement(TCSSClassNameElement)).Value:='::abc';
+  TCSSPseudoClassElement(CreateElement(TCSSPseudoClassElement)).Value:='::abc';
   AssertEquals('Value','::abc',Element.AsString);
 end;