implemented freepascal highlighter with nested comments issue #1991

git-svn-id: trunk@9601 -

components/synedit/synedithighlighter.pp

@@ -1211,15 +1211,6 @@ begin
   if FMinimumCodeFoldBlockLevel>CodeFoldRange.CodeFoldStackSize then
     FMinimumCodeFoldBlockLevel:=CodeFoldRange.CodeFoldStackSize;
 end;
-{$ELSE}
-procedure TSynCustomHighlighter.SetCodeFoldItem(Lines: TStrings; Line : integer; Folded: boolean;
-  FoldIndex: integer; FoldType: TSynEditCodeFoldType);
-begin
-end;
-
-procedure TSynCustomHighlighter.InitCodeFold(Lines: TStrings);
-begin
-end;
 {$ENDIF}
 
 {$IFNDEF SYN_CPPB_1}
@@ -1312,9 +1303,9 @@ end;
 
 procedure TSynCustomHighlighterRange.Pop;
 // can be called, even if there is no stack
-// because it's normal, that sources under development have unclosed blocks
+// because it's normal that sources under development have unclosed blocks
 begin
-  //debugln('TSynCustomHighlighterRange.Pop AAAAAAAAAAAA');
+  //debugln('TSynCustomHighlighterRange.Pop');
   if FCodeFoldStackSize>0 then
     dec(FCodeFoldStackSize);
   if FCodeFoldStackSize>0 then
@@ -1360,7 +1351,7 @@ begin
     Clear;
   end;
   if FCodeFoldStackSize>0 then
-    FTop:=FCodeFoldStack[0]
+    FTop:=FCodeFoldStack[FCodeFoldStackSize-1]
   else
     FTop:=nil;
 end;

components/synedit/synhighlighterpas.pp

@@ -65,12 +65,26 @@ type
     tkSpace, tkString, tkSymbol, {$IFDEF SYN_LAZARUS}tkDirective, {$ENDIF}
     tkUnknown);
 
-  TRangeState = (rsANil, rsAnsi, rsAnsiAsm, rsAsm, rsBor, rsBorAsm,
+  TRangeState = (
-    {$IFDEF SYN_LAZARUS}rsDirective, rsDirectiveAsm,{$ENDIF}
+    rsANil,
-    rsProperty, rsUnKnown);
+    rsAnsi,   // *) comment
+    rsAnsiAsm,// *) comment in assembler block
+    rsAsm,    // assembler block
+    rsBor,    // { comment
+    rsBorAsm, // { comment in assembler block
+    {$IFDEF SYN_LAZARUS}
+    rsDirective,
+    rsDirectiveAsm, // directive in assembler block
+    {$ENDIF}
+    rsProperty,
+    rsUnKnown);
     
   {$IFDEF SYN_LAZARUS}
-  TPascalCodeFoldBlockType = (cfbtNone, cfbtBeginEnd);
+  TPascalCodeFoldBlockType = (
+    cfbtNone,
+    cfbtBeginEnd,
+    cfbtNestedComment
+    );
   {$ENDIF}
 
   TProcTableProc = procedure of object;
@@ -112,9 +126,11 @@ type
     fSpaceAttri: TSynHighlighterAttributes;
     {$IFDEF SYN_LAZARUS}
     fDirectiveAttri: TSynHighlighterAttributes;
+    FNestedComments: boolean;
     {$ENDIF}
     fD4syntax: boolean;
     {$IFDEF SYN_LAZARUS}
+    function TextComp(aText: PChar): Boolean;
     function KeyHash: Integer;
     {$ELSE}
     function KeyHash(ToHash: PChar): Integer;
@@ -287,10 +303,19 @@ type
     {$IFDEF SYN_LAZARUS}
     property DirectiveAttri: TSynHighlighterAttributes read fDirectiveAttri
       write fDirectiveAttri;
+    property NestedComments: boolean read FNestedComments write FNestedComments;
     {$ENDIF}
     property D4syntax: boolean read FD4syntax write SetD4syntax default true;
   end;
 
+  { TSynFreePascalSyn }
+
+  TSynFreePascalSyn = class(TSynPasSyn)
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+
 implementation
 
 uses
@@ -563,6 +588,21 @@ begin
   end else Result := False;
 end; { KeyComp }
 
+{$IFDEF SYN_LAZARUS}
+function TSynPasSyn.TextComp(aText: PChar): Boolean;
+var
+  CurPos: PChar;
+begin
+  CurPos:=@fLine[Run];
+  while (aText<>#0) do begin
+    if mHashTable[aText^]<>mHashTable[CurPos^] then exit(false);
+    inc(aText);
+    inc(CurPos);
+  end;
+  Result:=true;
+end;
+{$ENDIF}
+
 function TSynPasSyn.Func15: TtkTokenKind;
 begin
   if KeyComp('If') then Result := tkKey else Result := tkIdentifier;
@@ -1186,6 +1226,7 @@ end; { Create }
 
 procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer);
 begin
+  //DebugLn(['TSynPasSyn.SetLine LineNumber=',LineNumber,' Line="',NewValue,'"']);
   {$IFDEF SYN_LAZARUS}
   fLine := NewValue;
   fLineLen:=length(fLine);
@@ -1223,6 +1264,30 @@ end;
 
 procedure TSynPasSyn.BorProc;
 begin
+  {$IFDEF SYN_LAZARUS}
+  fTokenID := tkComment;
+  repeat
+    case fLine[Run] of
+    #0: break;
+    '}':
+      if TopPascalCodeFoldBlockType=cfbtNestedComment then
+        EndCodeFoldBlock
+      else begin
+        if fRange = rsBorAsm then
+          fRange := rsAsm
+        else
+          fRange := rsUnKnown;
+        Inc(Run);
+        break;
+      end;
+    '{':
+      if NestedComments then begin
+        StartPascalCodeFoldBlock(cfbtNestedComment);
+      end;
+    end;
+    Inc(Run);
+  until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]);
+  {$ELSE}
   case fLine[Run] of
      #0: NullProc;
     #10: LFProc;
@@ -1239,44 +1304,45 @@ begin
           break;
         end;
         Inc(Run);
-      {$IFDEF SYN_LAZARUS}
-      until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]);
-      {$ELSE}
       until (fLine[Run] in [#0, #10, #13]);
+    end;
+  end;
   {$ENDIF}
 end;
-  end;
-end;
 
 {$IFDEF SYN_LAZARUS}
 procedure TSynPasSyn.DirectiveProc;
 begin
-  case fLine[Run] of
-     #0: NullProc;
-    #10: LFProc;
-    #13: CRProc;
-    else begin
   fTokenID := tkDirective;
   repeat
-        if fLine[Run] = '}' then begin
+    case fLine[Run] of
-          Inc(Run);
+    #0: break;
+    '}':
+      if TopPascalCodeFoldBlockType=cfbtNestedComment then
+        EndCodeFoldBlock
+      else begin
         if fRange = rsDirectiveAsm then
           fRange := rsAsm
         else
           fRange := rsUnKnown;
+        Inc(Run);
         break;
       end;
+    '{':
+      if NestedComments then begin
+        StartPascalCodeFoldBlock(cfbtNestedComment);
+      end;
+    end;
     Inc(Run);
   until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]);
 end;
-  end;
-end;
 {$ENDIF}
 
 procedure TSynPasSyn.BraceOpenProc;
 begin
   {$IFDEF SYN_LAZARUS}
   if (Run=fLineLen) or (fLine[Run+1]<>'$') then begin
+    inc(Run);
   {$ENDIF}
     if fRange = rsAsm then
       fRange := rsBorAsm
@@ -1285,11 +1351,11 @@ begin
     BorProc;
   {$IFDEF SYN_LAZARUS}
   end else begin
-    inc(Run);
     if fRange = rsAsm then
       fRange := rsDirectiveAsm
     else
       fRange := rsDirective;
+    inc(Run,2);
     DirectiveProc;
   end;
   {$ENDIF}
@@ -1401,6 +1467,22 @@ end;
 
 procedure TSynPasSyn.AnsiProc;
 begin
+  {$IFDEF SYN_LAZARUS}
+  fTokenID := tkComment;
+  repeat
+    if fLine[Run]=#0 then break;
+    if (fLine[Run] = '*') and (Run<fLineLen) and (fLine[Run + 1] = ')') then
+    begin
+      Inc(Run, 2);
+      if fRange = rsAnsiAsm then
+        fRange := rsAsm
+      else
+        fRange := rsUnKnown;
+      break;
+    end;
+    Inc(Run);
+  until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]);
+  {$ELSE}
   case fLine[Run] of
      #0: NullProc;
     #10: LFProc;
@@ -1408,12 +1490,7 @@ begin
   else
     fTokenID := tkComment;
     repeat
-      {$IFDEF SYN_LAZARUS}
-      if (fLine[Run] = '*') and (Run<fLineLen) and (fLine[Run + 1] = ')') then
-      begin
-      {$ELSE}
       if (fLine[Run] = '*') and (fLine[Run + 1] = ')') then begin
-      {$ENDIF}
         Inc(Run, 2);
         if fRange = rsAnsiAsm then
           fRange := rsAsm
@@ -1424,6 +1501,7 @@ begin
       Inc(Run);
     until (Run>fLineLen) or (fLine[Run] in [#0, #10, #13]);
   end;
+  {$ENDIF}
 end;
 
 procedure TSynPasSyn.RoundOpenProc;
@@ -1445,12 +1523,13 @@ begin
           fRange := rsAnsi;
         fTokenID := tkComment;
         {$IFDEF SYN_LAZARUS}
-        if (Run<=fLineLen) and not (fLine[Run] in [#0, #10, #13]) then
+        if (Run<=fLineLen) and not (fLine[Run] in [#0, #10, #13]) then begin
         {$ELSE}
-        if not (fLine[Run] in [#0, #10, #13]) then
+        if not (fLine[Run] in [#0, #10, #13]) then begin
         {$ENDIF}
           AnsiProc;
         end;
+      end;
     '.':
       begin
         inc(Run);
@@ -1548,6 +1627,11 @@ begin
     fTokenID := tkNull;
     exit;
   end;
+  case fLine[Run] of
+     #0: NullProc;
+    #10: LFProc;
+    #13: CRProc;
+  else
   {$ENDIF}
     case fRange of
       rsAnsi, rsAnsiAsm:
@@ -1561,6 +1645,9 @@ begin
     else
       fProcTable[fLine[Run]];
     end;
+  {$IFDEF SYN_LAZARUS}
+  end;
+  {$ENDIF}
 end;
 
 function TSynPasSyn.GetDefaultAttribute(Index: integer):
@@ -1871,6 +1958,14 @@ begin
   FD4syntax := Value;
 end;
 
+{ TSynFreePascalSyn }
+
+constructor TSynFreePascalSyn.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  NestedComments:=true;
+end;
+
 initialization
   MakeIdentTable;
 {$IFNDEF SYN_CPPB_1}

ide/editoroptions.pp

@@ -80,7 +80,7 @@ uses
 
 type
   TPreviewEditor = TSynEdit;
-  TPreviewPasSyn = TSynPasSyn;
+  TPreviewPasSyn = TSynFreePascalSyn;
                                                                                                                                                                                                                                                                                                                                                                                         TCustomSyn     = TSynCustomHighlighter;
   TSynHighlightElement = TSynHighlighterAttributes;
   TCustomSynClass = class of TCustomSyn;
@@ -111,8 +111,8 @@ const
 
   LazSyntaxHighlighterClasses: array[TLazSyntaxHighlighter] of
     TCustomSynClass =
-    (Nil, Nil, TSynPasSyn, TSynPasSyn, TSynLFMSyn, TSynXMLSyn, TSynHTMLSyn,
+    (Nil, Nil, TSynFreePascalSyn, TSynPasSyn, TSynLFMSyn, TSynXMLSyn,
-    TSynCPPSyn, TSynPerlSyn, TSynJavaSyn, TSynUNIXShellScriptSyn,
+    TSynHTMLSyn, TSynCPPSyn, TSynPerlSyn, TSynJavaSyn, TSynUNIXShellScriptSyn,
     TSynPythonSyn, TSynPHPSyn, TSynSQLSyn);