Browse Source

Nested comment syntax highlighting

Margers 10 months ago
parent
commit
67bee1b652
4 changed files with 497 additions and 30 deletions
  1. 3 2
      packages/ide/fpide.pas
  2. 29 0
      packages/ide/fpmopts.inc
  3. 365 12
      packages/ide/fpviews.pas
  4. 100 16
      packages/ide/weditor.pas

+ 3 - 2
packages/ide/fpide.pas

@@ -24,7 +24,7 @@ uses
   WEditor,WCEdit,
   WEditor,WCEdit,
   Comphook,Browcol,
   Comphook,Browcol,
   WHTMLScn,
   WHTMLScn,
-  FPViews,FPSymbol
+  FPViews,FPSymbol,FPSwitch
   {$ifndef NODEBUG}
   {$ifndef NODEBUG}
   ,fpevalw
   ,fpevalw
   {$endif};
   {$endif};
@@ -52,6 +52,7 @@ type
       procedure   UpdateMode;
       procedure   UpdateMode;
       procedure   UpdateRunMenu(DebuggeeRunning : boolean);
       procedure   UpdateRunMenu(DebuggeeRunning : boolean);
       procedure   UpdateTarget;
       procedure   UpdateTarget;
+      procedure   UpdateEditorsCompilerMode(OldMode:TCompilerMode);
       procedure   GetEvent(var Event: TEvent); virtual;
       procedure   GetEvent(var Event: TEvent); virtual;
       procedure   HandleEvent(var Event: TEvent); virtual;
       procedure   HandleEvent(var Event: TEvent); virtual;
       procedure   GetTileRect(var R: TRect); virtual;
       procedure   GetTileRect(var R: TRect); virtual;
@@ -184,7 +185,7 @@ uses
   Dos{,Memory},Menus,Dialogs,StdDlg,timeddlg,
   Dos{,Memory},Menus,Dialogs,StdDlg,timeddlg,
   Systems,
   Systems,
   WUtils,WHlpView,WViews,WHTMLHlp,WHelp,WConsole,
   WUtils,WHlpView,WViews,WHTMLHlp,WHelp,WConsole,
-  FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompil,FPHelp,
+  FPConst,FPVars,FPUtils,FPIni,FPIntf,FPCompil,FPHelp,
   FPTemplt,FPCalc,FPUsrScr,FPTools,
   FPTemplt,FPCalc,FPUsrScr,FPTools,
 {$ifndef NODEBUG}
 {$ifndef NODEBUG}
   FPDebug,FPRegs,
   FPDebug,FPRegs,

+ 29 - 0
packages/ide/fpmopts.inc

@@ -21,6 +21,7 @@ var R,R2: TRect;
     SwitchesCount : integer;
     SwitchesCount : integer;
     LastItem: PSItem;
     LastItem: PSItem;
     L: longint;
     L: longint;
+    OldCompilerMode: TCompilerMode;
 begin
 begin
   SwitchesCount:=ord(high(TSwitchMode))-ord(low(TSwitchMode))+1;
   SwitchesCount:=ord(high(TSwitchMode))-ord(low(TSwitchMode))+1;
   R.Assign(0,0,36,4+SwitchesCount);
   R.Assign(0,0,36,4+SwitchesCount);
@@ -52,8 +53,12 @@ begin
   end;
   end;
   InsertButtons(D);
   InsertButtons(D);
   RB^.Select;
   RB^.Select;
+  OldCompilerMode:=TCompilerMode(CompilerModeSwitches^.GetCurrSelParamID());
   if Desktop^.ExecView(D)=cmOK then
   if Desktop^.ExecView(D)=cmOK then
+  begin
    SwitchesMode:=TSwitchMode(RB^.Value);
    SwitchesMode:=TSwitchMode(RB^.Value);
+   UpdateEditorsCompilerMode(OldCompilerMode);
+  end;
   Dispose(D, Done);
   Dispose(D, Done);
   UpdateMode;
   UpdateMode;
   UpdateTarget;
   UpdateTarget;
@@ -77,6 +82,7 @@ var R,R2,R3,TabR,TabIR: TRect;
     Label31,Label41,
     Label31,Label41,
     Label51,Label52,Label53: PLabel;
     Label51,Label52,Label53: PLabel;
     TargetHeight,ProcessorHeight: sw_integer;
     TargetHeight,ProcessorHeight: sw_integer;
+    OldCompilerMode: TCompilerMode;
 begin
 begin
   {decide height of dialog view}
   {decide height of dialog view}
   GetExtent(R);
   GetExtent(R);
@@ -372,6 +378,7 @@ begin
   InsertButtons(D);
   InsertButtons(D);
   if Desktop^.ExecView(D)=cmOK then
   if Desktop^.ExecView(D)=cmOK then
   begin
   begin
+    OldCompilerMode:= TCompilerMode(CompilerModeSwitches^.GetCurrSelParamID());
     for I:=0 to SyntaxSwitches^.ItemCount-1 do
     for I:=0 to SyntaxSwitches^.ItemCount-1 do
       SyntaxSwitches^.SetBooleanItem(I,CB1^.Mark(I));
       SyntaxSwitches^.SetBooleanItem(I,CB1^.Mark(I));
     CompilerModeSwitches^.SetCurrSel(RB2^.Value);
     CompilerModeSwitches^.SetCurrSel(RB2^.Value);
@@ -390,10 +397,32 @@ begin
     BrowserSwitches^.SetCurrSel(RB4^.Value);
     BrowserSwitches^.SetCurrSel(RB4^.Value);
     ConditionalSwitches^.SetStringItem(0,IL^.Data^);
     ConditionalSwitches^.SetStringItem(0,IL^.Data^);
     CustomArg[SwitchesMode]:=IL2^.Data^;
     CustomArg[SwitchesMode]:=IL2^.Data^;
+    UpdateEditorsCompilerMode(OldCompilerMode);
   end;
   end;
   Dispose(D, Done);
   Dispose(D, Done);
 end;
 end;
 
 
+procedure TIDEApp.UpdateEditorsCompilerMode(OldMode:TCompilerMode);
+
+  procedure UpdateEditor(P: PView);
+  begin
+    if assigned(P) and (TypeOf(P^)=TypeOf(TSourceWindow)) then
+    begin
+      PSourceWindow(P)^.Editor^.UpdateAttrs(0,attrForceFull);
+      PSourceWindow(P)^.ReDraw;
+    end;
+  end;
+
+var NewMode:TCompilerMode;
+begin
+  NewMode:=TCompilerMode(CompilerModeSwitches^.GetCurrSelParamID());
+  if (OldMode in [moFpc,moObjfpc]) and not (NewMode in [moFpc,moObjfpc]) then
+    Desktop^.ForEach(TCallbackProcParam(@UpdateEditor))
+  else
+  if not (OldMode in [moFpc,moObjfpc]) and (NewMode in [moFpc,moObjfpc]) then
+    Desktop^.ForEach(TCallbackProcParam(@UpdateEditor));
+end;
+
 procedure TIDEApp.MemorySizes;
 procedure TIDEApp.MemorySizes;
 var R,R2,R3: TRect;
 var R,R2,R3: TRect;
     D: PCenterDialog;
     D: PCenterDialog;

+ 365 - 12
packages/ide/fpviews.pas

@@ -130,10 +130,19 @@ type
       Align: TAlign;
       Align: TAlign;
     end;
     end;
 
 
+const cMaxNestnessChanges = 20;
+type
+    TNestnessPoints = array[0..cMaxNestnessChanges-1] of record X,Y:sw_integer;NC:boolean; end;
+
     PSourceEditor = ^TSourceEditor;
     PSourceEditor = ^TSourceEditor;
     TSourceEditor = object(TFileEditor)
     TSourceEditor = object(TFileEditor)
       CompileStamp : longint;
       CompileStamp : longint;
       CodeCompleteTip: PFPToolTip;
       CodeCompleteTip: PFPToolTip;
+      {for nested comments managment}
+      NestedComments : boolean;
+      FixedNestedComments : TPoint;
+      NestnessPoints:TNestnessPoints;
+      NestPos : sw_integer;
       constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
       constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
           PScrollBar; AIndicator: PIndicator;const AFileName: string);
           PScrollBar; AIndicator: PIndicator;const AFileName: string);
 {$ifndef NODEBUG}
 {$ifndef NODEBUG}
@@ -146,6 +155,9 @@ type
       function  IsAsmReservedWord(const S: string): boolean; virtual;
       function  IsAsmReservedWord(const S: string): boolean; virtual;
       function  GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
       function  GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
       function  GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
       function  GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
+      function    ParseSourceNestedComments(X,Y : sw_integer): boolean; virtual;
+      function    IsNestedComments(X,Y : sw_integer): boolean; virtual;
+      function    NestedCommentsChangeCheck(CurLine : sw_integer):boolean; virtual;
       { CodeTemplates }
       { CodeTemplates }
       function    TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
       function    TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
       function    SelectCodeTemplate(var ShortCut: string): boolean; virtual;
       function    SelectCodeTemplate(var ShortCut: string): boolean; virtual;
@@ -573,8 +585,8 @@ uses
    fpintf, { superseeds version_string of version unit }
    fpintf, { superseeds version_string of version unit }
 {$endif USE_EXTERNAL_COMPILER}
 {$endif USE_EXTERNAL_COMPILER}
   {$ifdef VESA}Vesa,{$endif}
   {$ifdef VESA}Vesa,{$endif}
-  FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
-  FPTools,FPIDE,FPCodTmp,FPCodCmp;
+  FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
+  FPTools,FPIDE,FPCodTmp,FPCodCmp,FPSwitch;
 
 
 const
 const
   RSourceEditor: TStreamRec = (
   RSourceEditor: TStreamRec = (
@@ -1283,6 +1295,8 @@ begin
   inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
   inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
   SetStoreUndo(true);
   SetStoreUndo(true);
   CompileStamp:=0;
   CompileStamp:=0;
+  FixedNestedComments.Y:=2000001;
+  NestedComments:=false;
 end;
 end;
 
 
 Const
 Const
@@ -1293,8 +1307,8 @@ Const
     2,{ssCommentSuffix}
     2,{ssCommentSuffix}
     1,{ssStringPrefix}
     1,{ssStringPrefix}
     1,{ssStringSuffix}
     1,{ssStringSuffix}
-    1,{ssDirectivePrefix}
-    1,{ssDirectiveSuffix}
+    2,{ssDirectivePrefix}
+    {2,}{ssDirectiveSuffix}
     1,{ssAsmPrefix}
     1,{ssAsmPrefix}
     1 {ssAsmSuffix}
     1 {ssAsmSuffix}
   );
   );
@@ -1308,8 +1322,10 @@ Const
   FreePascalCommentSuffix2 : string[2] = '*)';
   FreePascalCommentSuffix2 : string[2] = '*)';
   FreePascalStringPrefix : string[1] = '''';
   FreePascalStringPrefix : string[1] = '''';
   FreePascalStringSuffix : string[1] = '''';
   FreePascalStringSuffix : string[1] = '''';
-  FreePascalDirectivePrefix : string[2] = '{$';
-  FreePascalDirectiveSuffix : string[1] = '}';
+  FreePascalDirectivePrefix1 : string[2] = '{$';
+  FreePascalDirectivePrefix2 : string[3] = '(*$';
+  //FreePascalDirectiveSuffix1 : string[1] = '}';
+  //FreePascalDirectiveSuffix2 : string[2] = '*)';
   FreePascalAsmPrefix : string[3] = 'ASM';
   FreePascalAsmPrefix : string[3] = 'ASM';
   FreePascalAsmSuffix : string[3] = 'END';
   FreePascalAsmSuffix : string[3] = 'END';
 
 
@@ -1347,9 +1363,15 @@ begin
     ssAsmSuffix :
     ssAsmSuffix :
       GetSpecSymbol:=@FreePascalAsmSuffix;
       GetSpecSymbol:=@FreePascalAsmSuffix;
     ssDirectivePrefix :
     ssDirectivePrefix :
-      GetSpecSymbol:=@FreePascalDirectivePrefix;
-    ssDirectiveSuffix :
-      GetSpecSymbol:=@FreePascalDirectiveSuffix;
+      case Index of
+        0 : GetSpecSymbol:=@FreePascalDirectivePrefix1;
+        1 : GetSpecSymbol:=@FreePascalDirectivePrefix2;
+      end;
+    {ssDirectiveSuffix :
+      case Index of
+        0 : GetSpecSymbol:=@FreePascalDirectiveSuffix1;
+        1 : GetSpecSymbol:=@FreePascalDirectiveSuffix2;
+      end;}
   end;
   end;
 end;
 end;
 
 
@@ -1363,6 +1385,331 @@ begin
   IsAsmReservedWord:=IsFPAsmReservedWord(S);
   IsAsmReservedWord:=IsFPAsmReservedWord(S);
 end;
 end;
 
 
+function TSourceEditor.ParseSourceNestedComments(X,Y : sw_integer): boolean;
+const cModeNestedComments : array [TCompilerMode] of boolean =
+ (false,true{fpc},true{objfpc},false,false,false,false,false,false,false);
+
+function CompilerModeToNestedComments(AMode: String; ACurrentNestedComments:boolean):boolean;
+var SourceCompilerMode : TCompilerMode;
+begin
+  SourceCompilerMode:=moNone;
+  case length(AMode) of
+    2 : if AMode='tp' then
+          SourceCompilerMode:=moTp;
+    3 : if AMode='fpc' then
+          SourceCompilerMode:=moFpc
+        else if AMode='iso' then
+          SourceCompilerMode:=moIso;
+    6 : if AMode='objfpc' then
+          SourceCompilerMode:=moObjFpc
+        else if AMode='delphi' then
+          SourceCompilerMode:=moDelphi
+        else if AMode='macpas' then
+          SourceCompilerMode:=moMacPas;
+    13: if AMode='delphiunicode' then
+          SourceCompilerMode:=moDelphiUnicode;
+    14: if AMode='extendedpascal' then
+          SourceCompilerMode:=moExtendedPascal;
+  end;
+  if SourceCompilerMode=moNone then
+    CompilerModeToNestedComments:=ACurrentNestedComments
+  else
+    CompilerModeToNestedComments:=cModeNestedComments[SourceCompilerMode];
+end;
+
+procedure RegisterNestnessPoint( LineNr, X : sw_integer);
+begin
+  NestnessPoints[NestPos].X:=X;
+  NestnessPoints[NestPos].Y:=LineNr;
+  NestnessPoints[NestPos].NC:=NestedComments;
+  inc(NestPos);
+  if NestPos=cMaxNestnessChanges then NestPos:=0;
+end;
+
+var CurrentCompilerMode : TCompilerMode;
+    CurX,CurY:sw_integer;
+    S : sw_astring;
+    crWord,prWord : sw_astring;
+    ch,prCh,prprCh : AnsiChar;
+    CommentStartX,CommentStartY:sw_integer;
+    WordNpk : sw_integer;
+    inCompilerDirective : boolean;
+    inLineComment       : boolean;
+    inCurlyBracketComment : boolean;
+    inBracketComment    : boolean;
+    inString            : boolean;
+    CommentDepth: sw_integer;
+    CompilerDirective: sw_integer;
+    ResultIsSet : boolean;
+begin
+  CurrentCompilerMode:=TCompilerMode(CompilerModeSwitches^.GetCurrSelParamID);
+  NestedComments:=cModeNestedComments[CurrentCompilerMode];
+  ParseSourceNestedComments:=NestedComments;
+  ResultIsSet:=false;
+  RegisterNestnessPoint(0,0);
+  if (not IsFlagSet(efSyntaxHighlight)) then
+  begin {not ment to be syntax highlighted }
+    FixedNestedComments.Y:=0;
+    FixedNestedComments.X:=0;
+    exit;
+  end;
+  FixedNestedComments.Y:=2000001;
+  CurX:=0;
+  CurY:=0;
+  inCompilerDirective:=false;
+  inLineComment:=false;
+  inCurlyBracketComment:=false;
+  inBracketComment:=false;
+  inString:=false;
+  CommentDepth:=0;
+  CompilerDirective:=0;
+  WordNpk:=0;
+  NestPos:=0;
+  while CurY<GetLineCount do
+  begin
+    S:=GetLineText(CurY)+' ';
+    prCh:=#0;prprCh:=#0;
+    CurX:=0;
+    while CurX < length(S) do
+    begin
+      inc(CurX);
+      ch := S[CurX];
+      {-- comment part --}
+      if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
+      if (ch = '{') then
+      begin
+           inCurlyBracketComment:=true;
+           CommentDepth:=0;
+           CommentStartX:=CurX;
+           CommentStartY:=CurY;
+      end else
+      if (ch = '*') and (prCh='(') then
+      begin
+           inBracketComment:=true;
+           CommentDepth:=0;
+           CommentStartX:=CurX;
+           CommentStartY:=CurY;
+      end;
+      if (ch = '{') and inCurlyBracketComment then
+        inc(CommentDepth);
+      if (ch = '*') and (prCh='(') and inBracketComment then
+      begin
+        inc(CommentDepth);
+        if CurX < length(S) then if S[CurX+1] = ')' then
+          dec(CommentDepth); {in comment (*) is not begin comment but end}
+      end;
+      if (ch = '$') and (prCh='{') and inCurlyBracketComment and (CommentDepth=1) then
+      begin
+        inCompilerDirective:=true;
+        CompilerDirective:=1;
+        WordNpk:=0;
+      end;
+      if (ch = '$') and (prCh='*') and (prprCh='(') and inBracketComment and (CommentDepth=1) then
+      begin
+        inCompilerDirective:=true;
+        CompilerDirective:=2;
+        WordNpk:=0;
+      end;
+      if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
+      if (ch = '/') and (prCh = '/') then
+           inLineComment:=true;
+      {-- string part --}
+      if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
+      if (ch = '''') then
+        inString:=true;
+      if (ch = '''') and inString then
+        inString:=false;
+      {-- word part --}
+      if ch in ['a'..'z','.','_','A'..'Z','0'..'9'] then
+        crWord:=crWord+ch
+      else begin
+        if length(crWord)>0 then
+        begin
+          crWord:=LowcaseStr(crWord);
+          if inCompilerDirective then
+          begin
+            inc(WordNpk);
+            if WordNpk=2 then
+            begin
+              if (prWord='mode') then
+              begin
+                NestedComments:=CompilerModeToNestedComments(crWord,NestedComments);
+                RegisterNestnessPoint(CurY,CurX-1);
+              end else
+              if (prWord='modeswitch') and (crWord='nestedcomments') then
+                begin
+                  if ch='-' then
+                    NestedComments:=false
+                  else
+                    NestedComments:=true;
+                  RegisterNestnessPoint(CurY,CurX-1);
+                end;
+            end;
+          end;
+          if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
+          begin
+            if (crWord='uses')
+              or (crWord='type')
+              or (crWord='var')
+              or (crWord='const')
+              or (crWord='begin')
+              or (crWord='implementation')
+              or (crWord='function')
+              or (crWord='procedure')
+              then
+            begin
+              FixedNestedComments.Y:=CurY;
+              FixedNestedComments.X:=CurX-1;
+              if not ResultIsSet then
+                ParseSourceNestedComments:=NestedComments;
+              exit;
+            end;
+          end;
+        end;
+        prWord:=crWord;
+        crWord:='';
+      end;
+      { --- comment close part ---- }
+      if (ch = '}') and inCurlyBracketComment then
+      begin
+        dec(CommentDepth);
+        if not NestedComments then
+          CommentDepth:=0;
+        if CommentDepth=0 then
+          inCurlyBracketComment:=false;
+      end;
+      if (ch = ')') and (prCh='*') and inBracketComment then
+      begin
+        if (CommentStartY<>CurY) or ((CommentStartY=CurY) and ((CurX-CommentStartX)>3)) then
+        begin
+          dec(CommentDepth);
+          if not NestedComments then
+            CommentDepth:=0;
+          if CommentDepth=0 then
+            inBracketComment:=false;
+        end;
+      end;
+      if (ch = '}') and inCompilerDirective and not inCurlyBracketComment then
+           inCompilerDirective:=false;
+      if (ch = ')') and (prCh='*') and inCompilerDirective and not inBracketComment then
+         inCompilerDirective:=false;
+      { --- result --- }
+      if (CurY=Y) and ((CurX-1)=X) then
+      begin
+        ParseSourceNestedComments:=NestedComments;
+        ResultIsSet:=true;
+      end;
+      prprCh:=prCh;
+      prCh:=ch;
+    end; {end while one line}
+    if inLineComment then
+      inLineComment:=false;
+    inc(CurY); {next line}
+    if CurY=200 then break; {give up on line 200, it might not be a pascal source after all}
+  end; {end while all lines}
+  FixedNestedComments.Y:=CurY; { full(200 lines) parse was done }
+  FixedNestedComments.X:=CurX;
+end;
+
+function TSourceEditor.IsNestedComments(X,Y : sw_integer): boolean;
+var iPos : sw_integer;
+    lastNC : boolean;
+begin
+  if (FixedNestedComments.Y<Y) or ((FixedNestedComments.Y=Y) and (FixedNestedComments.X<=X)) then
+  begin  {we are at point where comment nestness is determined }
+    IsNestedComments:=NestedComments;
+  end else
+  begin
+    lastNC:=NestedComments;
+    if NestPos>0 then
+      for iPos:=0 to NestPos-1 do
+      begin
+        if (NestnessPoints[iPos].Y>Y) or ((NestnessPoints[iPos].Y=Y) and (NestnessPoints[iPos].X>=X)) then
+          break;
+        lastNC:=NestnessPoints[iPos].NC;
+      end;
+    IsNestedComments:=lastNC;
+  end;
+end;
+
+function TSourceEditor.NestedCommentsChangeCheck(CurLine : sw_integer):boolean;
+
+function CheckTantedLine(LineNr : sw_integer):boolean;
+function OneInTantetList (AWord : string):boolean;
+begin
+  OneInTantetList:=false;
+  if AWord='$mode' then OneInTantetList:=true else
+  if AWord='nestedcomments' then OneInTantetList:=true;
+end;
+var S : sw_astring;
+    CurX : sw_integer;
+    ch, fo : AnsiChar;
+    crWord : String;
+    el : boolean;
+begin
+  CheckTantedLine:=false;
+  S:=GetLineText(LineNr);
+  crWord:='';
+  For CurX:=1 to length(S) do
+  begin
+    if length(crWord)=255 then crWord:=''; {overflow}
+    ch:=LowCase(S[CurX]);
+    el:=true;
+    if ch in ['$','a'..'z'] then
+    begin
+      crWord:=crWord+ch;
+      el:=false;
+    end;
+    if (el or (CurX=length(S))) and (crWord<>'') then
+    begin
+      if OneInTantetList(crWord) then
+      begin
+        CheckTantedLine:=true;
+        break;
+      end;
+      crWord:='';
+    end;
+  end;
+end;
+
+var Points : TNestnessPoints;
+    iPos,iFrom,oNest : sw_integer;
+begin
+  NestedCommentsChangeCheck:=false;
+  if (FixedNestedComments.Y>=CurLine) then
+  begin
+    if FixedNestedComments.Y>=2000000 then
+    begin
+      ParseSourceNestedComments(0,CurLine+1);
+      NestedCommentsChangeCheck:=true;
+    end else
+    begin
+      Points:=NestnessPoints;
+      iFrom:=-1;oNest:=NestPos;
+      if NestPos>0 then
+        for iPos:=0 to NestPos-1 do
+          if Points[iPos].Y=CurLine then
+            if iFrom<0 then begin iFrom:=iPos;break; end;
+      if (iFrom>=0) or CheckTantedLine(CurLine) then
+      begin  {we have something to checkup}
+        ParseSourceNestedComments(0,CurLine+1);
+        if oNest=NestPos then
+        begin
+          for iPos:=0 to NestPos-1 do
+          begin
+            if Points[iPos].NC<>NestnessPoints[iPos].NC then
+            begin
+              NestedCommentsChangeCheck:=true;
+              break;
+            end;
+          end;
+        end else
+          NestedCommentsChangeCheck:=true;
+      end;
+    end;
+  end;
+end;
+
 function TSourceEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
 function TSourceEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
 begin
 begin
   TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
   TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
@@ -4720,9 +5067,15 @@ begin
     ssAsmSuffix :
     ssAsmSuffix :
       GetSpecSymbol:=@FreePascalAsmSuffix;
       GetSpecSymbol:=@FreePascalAsmSuffix;
     ssDirectivePrefix :
     ssDirectivePrefix :
-      GetSpecSymbol:=@FreePascalDirectivePrefix;
-    ssDirectiveSuffix :
-      GetSpecSymbol:=@FreePascalDirectiveSuffix;
+      case Index of
+        0 : GetSpecSymbol:=@FreePascalDirectivePrefix1;
+        1 : GetSpecSymbol:=@FreePascalDirectivePrefix2;
+      end;
+    {ssDirectiveSuffix :
+      case Index of
+        0 : GetSpecSymbol:=@FreePascalDirectiveSuffix1;
+        1 : GetSpecSymbol:=@FreePascalDirectiveSuffix2;
+      end;}
   end;
   end;
 end;
 end;
 
 

+ 100 - 16
packages/ide/weditor.pas

@@ -266,6 +266,8 @@ type
       BeginsWithDirective,
       BeginsWithDirective,
       EndsWithDirective : boolean;
       EndsWithDirective : boolean;
       BeginCommentType,EndCommentType : byte;
       BeginCommentType,EndCommentType : byte;
+      BeginCommentDepth,EndCommentDepth : sw_integer;
+      BeginNestedComments,EndNestedComments : byte;
       Fold: PFold;
       Fold: PFold;
       constructor Init(AEditor: PCustomCodeEditor);
       constructor Init(AEditor: PCustomCodeEditor);
       destructor  Done; virtual;
       destructor  Done; virtual;
@@ -345,7 +347,7 @@ type
 
 
     TSpecSymbolClass =
     TSpecSymbolClass =
       (ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
       (ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
-       ssDirectivePrefix,ssDirectiveSuffix,ssAsmPrefix,ssAsmSuffix);
+       ssDirectivePrefix{,ssDirectiveSuffix},ssAsmPrefix,ssAsmSuffix);
 
 
     TEditorBookMark = record
     TEditorBookMark = record
       Valid  : boolean;
       Valid  : boolean;
@@ -510,6 +512,8 @@ type
    {a}procedure   SetSyntaxCompleted(SC: boolean); virtual;
    {a}procedure   SetSyntaxCompleted(SC: boolean); virtual;
    {a}function    GetLastSyntaxedLine: sw_integer; virtual;
    {a}function    GetLastSyntaxedLine: sw_integer; virtual;
    {a}procedure   SetLastSyntaxedLine(ALine: sw_integer); virtual;
    {a}procedure   SetLastSyntaxedLine(ALine: sw_integer); virtual;
+      function    IsNestedComments(X,Y : sw_integer): boolean; virtual;
+      function    NestedCommentsChangeCheck(CurLine : sw_integer):boolean; virtual;
       function    IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
       function    IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
       function    GetReservedColCount: sw_integer; virtual;
       function    GetReservedColCount: sw_integer; virtual;
    {a}function    GetTabSize: integer; virtual;
    {a}function    GetTabSize: integer; virtual;
@@ -2108,8 +2112,12 @@ function TCustomCodeEditorCore.UpdateAttrs(FromLine: sw_integer; Attrs: byte): s
 var MinLine: sw_integer;
 var MinLine: sw_integer;
 procedure CallIt(P: PEditorBinding);
 procedure CallIt(P: PEditorBinding);
 var I: sw_integer;
 var I: sw_integer;
+    AAttrs:byte;
 begin
 begin
-  I:=DoUpdateAttrs(P^.Editor,FromLine,Attrs);
+  AAttrs:=Attrs;
+  if P^.Editor^.NestedCommentsChangeCheck(FromLine) then
+    AAttrs:=Attrs or attrForceFull;
+  I:=DoUpdateAttrs(P^.Editor,FromLine,AAttrs);
   if (I<MinLine) or (MinLine=-1) then MinLine:=I;
   if (I<MinLine) or (MinLine=-1) then MinLine:=I;
 end;
 end;
 begin
 begin
@@ -2122,7 +2130,11 @@ function TCustomCodeEditorCore.UpdateAttrsRange(FromLine, ToLine: sw_integer; At
 var MinLine: sw_integer;
 var MinLine: sw_integer;
 procedure CallIt(P: PEditorBinding);
 procedure CallIt(P: PEditorBinding);
 var I: sw_integer;
 var I: sw_integer;
+    AAttrs:byte;
 begin
 begin
+  AAttrs:=Attrs;
+  if P^.Editor^.NestedCommentsChangeCheck(FromLine) then
+    AAttrs:=Attrs or attrForceFull;
   I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
   I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
   if (I<MinLine) or (MinLine=-1) then MinLine:=I;
   if (I<MinLine) or (MinLine=-1) then MinLine:=I;
 end;
 end;
@@ -2139,7 +2151,11 @@ type
       ccHash,ccSymbol);
       ccHash,ccSymbol);
 var
 var
   SymbolIndex: Sw_integer;
   SymbolIndex: Sw_integer;
+  CurLineNr: Sw_integer;
   CurrentCommentType : Byte;
   CurrentCommentType : Byte;
+  CurrentCommentDepth : sw_integer;
+  NestedComments,LookForNestedComments : boolean;
+  CommentStartX,CommentStartY : sw_integer;
   FirstCC,LastCC: TCharClass;
   FirstCC,LastCC: TCharClass;
   InAsm,InComment,InSingleLineComment,InDirective,InString: boolean;
   InAsm,InComment,InSingleLineComment,InDirective,InString: boolean;
   X,ClassStart: Sw_integer;
   X,ClassStart: Sw_integer;
@@ -2235,6 +2251,18 @@ var
   begin
   begin
     IsCommentPrefix:=MatchesAnySpecSymbol(ssCommentPrefix,pmLeft);
     IsCommentPrefix:=MatchesAnySpecSymbol(ssCommentPrefix,pmLeft);
   end;
   end;
+
+  function IsMatchingCommentPrefix: boolean;
+  var tmpIs : boolean;
+  begin  {looking for nested comments with matching prefix}
+    tmpIs:=(MatchesAnySpecSymbol(ssCommentPrefix,pmLeft));
+    if tmpIs
+      and (CurrentCommentType=2) {bad, we are making assumption that this is comment opener (* }
+      and (LineText[X+1]=')') { looking into next char is bad aproach but it is working }
+      then
+        tmpIs:=false;  { in comment this "(*)" is not start of new nested comment but end }
+    IsMatchingCommentPrefix:= tmpIs and (CurrentCommentType=SymbolIndex);
+  end;
                               {** **}
                               {** **}
   function IsSingleLineCommentPrefix: boolean;
   function IsSingleLineCommentPrefix: boolean;
   begin
   begin
@@ -2242,9 +2270,13 @@ var
   end;
   end;
 
 
   function IsCommentSuffix: boolean;
   function IsCommentSuffix: boolean;
+  var tmpIs : boolean;
   begin
   begin
-    IsCommentSuffix:=(MatchesAnySpecSymbol(ssCommentSuffix,pmRight))
+    tmpIs:=(MatchesAnySpecSymbol(ssCommentSuffix,pmRight))
       and (CurrentCommentType=SymbolIndex);
       and (CurrentCommentType=SymbolIndex);
+    if tmpIs then
+      tmpIs:=(CurLineNr<>CommentStartY) or ((CurLineNr=CommentStartY) and ((X-length(MatchingSymbol))-CommentStartX>=0));
+    IsCommentSuffix:=tmpIs;
   end;
   end;
 
 
   function IsStringPrefix: boolean;
   function IsStringPrefix: boolean;
@@ -2259,13 +2291,15 @@ var
 
 
   function IsDirectivePrefix: boolean;
   function IsDirectivePrefix: boolean;
   begin
   begin
-    IsDirectivePrefix:=MatchesAnySpecSymbol(ssDirectivePrefix,pmLeft);
+    IsDirectivePrefix:=MatchesAnySpecSymbol(ssDirectivePrefix,pmLeft)
+      and (CurrentCommentType=SymbolIndex); {yes - matching comment type}
   end;
   end;
 
 
+  { Directive is treated as comment. Comment suffix will close directive.
   function IsDirectiveSuffix: boolean;
   function IsDirectiveSuffix: boolean;
   begin
   begin
     IsDirectiveSuffix:=MatchesAnySpecSymbol(ssDirectiveSuffix,pmRight);
     IsDirectiveSuffix:=MatchesAnySpecSymbol(ssDirectiveSuffix,pmRight);
-  end;
+  end;}
 
 
   function IsAsmPrefix(const WordS: string): boolean;
   function IsAsmPrefix(const WordS: string): boolean;
   { var
   { var
@@ -2409,9 +2443,9 @@ var
            if  InComment and IsCommentSuffix then
            if  InComment and IsCommentSuffix then
               Inc(EX) else
               Inc(EX) else
            if InString and IsStringSuffix  then
            if InString and IsStringSuffix  then
-              Inc(EX) else
+              Inc(EX) {else
            if InDirective and IsDirectiveSuffix then
            if InDirective and IsDirectiveSuffix then
-              Inc(EX);
+              Inc(EX)};
          end;
          end;
         if CC=ccRealNumber then
         if CC=ccRealNumber then
           Inc(EX);
           Inc(EX);
@@ -2427,35 +2461,58 @@ var
           ccNumber :
           ccNumber :
             if (LastCC<>ccAlpha) then;
             if (LastCC<>ccAlpha) then;
           ccSymbol :
           ccSymbol :
-              if (InComment=true) and (CurrentCommentType=1) and
+              if (InComment=true) and (CurrentCommentDepth=1) and
                  (InDirective=false)  and IsDirectivePrefix then
                  (InDirective=false)  and IsDirectivePrefix then
                 begin
                 begin
                   InDirective:=true;
                   InDirective:=true;
-                  InComment:=false;
+                  {InComment:=false;} { treat compiler directive as comment }
+                  {CurrentCommentType:=0;}
                   Dec(ClassStart,length(MatchingSymbol)-1);
                   Dec(ClassStart,length(MatchingSymbol)-1);
                 end
                 end
-              else if (InComment=false) and
+              else {if (InComment=false) and
                  (InDirective=true) and IsDirectiveSuffix then
                  (InDirective=true) and IsDirectiveSuffix then
                  InDirective:=false
                  InDirective:=false
-              else if (InComment=false) and
+              else }if (InComment=false) and
                  (InString=false) and (InDirective=false) and IsCommentPrefix then
                  (InString=false) and (InDirective=false) and IsCommentPrefix then
                 begin
                 begin
                   InComment:=true;
                   InComment:=true;
+                  LookForNestedComments:=true;
                   CurrentCommentType:=SymbolIndex;
                   CurrentCommentType:=SymbolIndex;
+                  CurrentCommentDepth:=1;
                   InSingleLineComment:=IsSingleLineCommentPrefix;
                   InSingleLineComment:=IsSingleLineCommentPrefix;
+                  CommentStartX:=X;
+                  CommentStartY:=CurLineNr;
                   {InString:=false; }
                   {InString:=false; }
                   Dec(ClassStart,length(MatchingSymbol)-1);
                   Dec(ClassStart,length(MatchingSymbol)-1);
                   { Remove (* from SymbolConcat to avoid problem with (*) PM }
                   { Remove (* from SymbolConcat to avoid problem with (*) PM }
                   { fixes part of bug 1617 }
                   { fixes part of bug 1617 }
                   { but removed proper directive prefix detection ... }
                   { but removed proper directive prefix detection ... }
+                  { Well. Added false positive end suffix detection. Do not remove. M
                   EndComment:=Editor^.GetSpecSymbol(ssCommentSuffix,SymbolIndex);
                   EndComment:=Editor^.GetSpecSymbol(ssCommentSuffix,SymbolIndex);
                   if MatchingSymbol[length(MatchingSymbol)]=EndComment^[1] then
                   if MatchingSymbol[length(MatchingSymbol)]=EndComment^[1] then
-                    Delete(SymbolConcat,1,length(MatchingSymbol));
+                    Delete(SymbolConcat,1,length(MatchingSymbol));}
+                end
+              else if InComment and IsMatchingCommentPrefix then
+                begin
+                  inc(CurrentCommentDepth);
+                  if LookForNestedComments then
+                  begin  { once per every nested comment test IsNestedCommments }
+                    LookForNestedComments:=false;
+                    NestedComments:=Editor^.IsNestedComments(X,CurLineNr);
+                  end;
                 end
                 end
               else if InComment and IsCommentSuffix then
               else if InComment and IsCommentSuffix then
                 begin
                 begin
-                  InComment:=false;
-                  InString:=false;
+                  dec(CurrentCommentDepth);
+                  if not NestedComments then
+                    CurrentCommentDepth:=0;
+                  if CurrentCommentDepth=0 then
+                  begin
+                    InComment:=false;
+                    CurrentCommentType:=0;
+                    InDirective:=false; {not in comment then not in Directive}
+                    InString:=false;
+                  end;
                 end
                 end
               else if (InComment=false) and (InString=false) and IsStringPrefix then
               else if (InComment=false) and (InString=false) and IsStringPrefix then
                 begin
                 begin
@@ -2471,8 +2528,7 @@ var
       end;
       end;
   end;
   end;
 
 
-var CurLineNr: Sw_integer;
-    Line,NextLine,PrevLine{,OldLine}: PCustomLine;
+var Line,NextLine,PrevLine{,OldLine}: PCustomLine;
     PrevLI,LI,nextLI: PEditorLineInfo;
     PrevLI,LI,nextLI: PEditorLineInfo;
 begin
 begin
   if (not Editor^.IsFlagSet(efSyntaxHighlight)) or (FromLine>=GetLineCount) then
   if (not Editor^.IsFlagSet(efSyntaxHighlight)) or (FromLine>=GetLineCount) then
@@ -2503,6 +2559,7 @@ begin
     PrevLine:=GetLine(CurLineNr-1)
     PrevLine:=GetLine(CurLineNr-1)
   else
   else
     PrevLine:=nil;
     PrevLine:=nil;
+  CommentStartY:=CurLineNr-1; { use in detection for false positive commment: (*) }
   repeat
   repeat
     Line:=GetLine(CurLineNr);
     Line:=GetLine(CurLineNr);
     if Assigned(PrevLine) then PrevLI:=PrevLine^.GetEditorInfo(Editor) else PrevLI:=nil;
     if Assigned(PrevLine) then PrevLI:=PrevLine^.GetEditorInfo(Editor) else PrevLI:=nil;
@@ -2513,6 +2570,9 @@ begin
        InAsm:=PrevLI^.EndsWithAsm;
        InAsm:=PrevLI^.EndsWithAsm;
        InComment:=PrevLI^.EndsWithComment and not PrevLI^.EndsInSingleLineComment;
        InComment:=PrevLI^.EndsWithComment and not PrevLI^.EndsInSingleLineComment;
        CurrentCommentType:=PrevLI^.EndCommentType;
        CurrentCommentType:=PrevLI^.EndCommentType;
+       CurrentCommentDepth:=PrevLI^.EndCommentDepth;
+       NestedComments:=(PrevLI^.EndNestedComments and 1)=1;
+       LookForNestedComments:=(PrevLI^.EndNestedComments and 2)=2;
        InDirective:=PrevLI^.EndsWithDirective;
        InDirective:=PrevLI^.EndsWithDirective;
      end
      end
     else
     else
@@ -2520,7 +2580,10 @@ begin
        InAsm:=false;
        InAsm:=false;
        InComment:=false;
        InComment:=false;
        CurrentCommentType:=0;
        CurrentCommentType:=0;
+       CurrentCommentDepth:=0;
        InDirective:=false;
        InDirective:=false;
+       NestedComments:=false;
+       LookForNestedComments:=false;
      end;
      end;
 {    OldLine:=Line;}
 {    OldLine:=Line;}
     if (not Editor^.IsFlagSet(efKeepLineAttr)) then
     if (not Editor^.IsFlagSet(efKeepLineAttr)) then
@@ -2529,6 +2592,9 @@ begin
         LI^.BeginsWithComment:=InComment;
         LI^.BeginsWithComment:=InComment;
         LI^.BeginsWithDirective:=InDirective;
         LI^.BeginsWithDirective:=InDirective;
         LI^.BeginCommentType:=CurrentCommentType;
         LI^.BeginCommentType:=CurrentCommentType;
+        LI^.BeginCommentDepth:=CurrentCommentDepth;
+        LI^.BeginNestedComments:=byte(NestedComments) and 1;
+        LI^.BeginNestedComments:=LI^.BeginNestedComments or ((byte(LookForNestedComments)and 1) shl 1);
       end
       end
     else
     else
       begin
       begin
@@ -2536,6 +2602,9 @@ begin
         InComment:=LI^.BeginsWithComment;
         InComment:=LI^.BeginsWithComment;
         InDirective:=LI^.BeginsWithDirective;
         InDirective:=LI^.BeginsWithDirective;
         CurrentCommentType:=LI^.BeginCommentType;
         CurrentCommentType:=LI^.BeginCommentType;
+        CurrentCommentDepth:=LI^.BeginCommentDepth;
+        NestedComments:=(LI^.BeginNestedComments and 1)=1;
+        LookForNestedComments:=(LI^.BeginNestedComments and 2)=2;
       end;
       end;
     LineText:=GetLineText(CurLineNr);
     LineText:=GetLineText(CurLineNr);
     Format:=CharStr(chr(coTextColor),length(LineText));
     Format:=CharStr(chr(coTextColor),length(LineText));
@@ -2554,6 +2623,9 @@ begin
     LI^.EndsWithAsm:=InAsm;
     LI^.EndsWithAsm:=InAsm;
     LI^.EndsWithComment:=InComment;
     LI^.EndsWithComment:=InComment;
     LI^.EndsInSingleLineComment:=InSingleLineComment;
     LI^.EndsInSingleLineComment:=InSingleLineComment;
+    LI^.EndNestedComments:=byte(NestedComments) and 1;
+    LI^.EndNestedComments:=LI^.EndNestedComments or ((byte(LookForNestedComments)and 1) shl 1);
+    LI^.EndCommentDepth:=CurrentCommentDepth;
     LI^.EndCommentType:=CurrentCommentType;
     LI^.EndCommentType:=CurrentCommentType;
     LI^.EndsWithDirective:=InDirective;
     LI^.EndsWithDirective:=InDirective;
     Inc(CurLineNr);
     Inc(CurLineNr);
@@ -2577,6 +2649,8 @@ begin
          (NextLI^.BeginsWithComment=LI^.EndsWithComment) and
          (NextLI^.BeginsWithComment=LI^.EndsWithComment) and
          (NextLI^.BeginsWithDirective=LI^.EndsWithDirective) and
          (NextLI^.BeginsWithDirective=LI^.EndsWithDirective) and
          (NextLI^.BeginCommentType=LI^.EndCommentType) and
          (NextLI^.BeginCommentType=LI^.EndCommentType) and
+         (NextLI^.BeginNestedComments=LI^.EndNestedComments) and
+         (NextLI^.BeginCommentDepth=LI^.EndCommentDepth) and
          (Length(NextLI^.GetFormat)>0) then
          (Length(NextLI^.GetFormat)>0) then
        Break;
        Break;
 {$ifdef TEST_PARTIAL_SYNTAX}
 {$ifdef TEST_PARTIAL_SYNTAX}
@@ -2796,6 +2870,16 @@ begin
   Abstract;
   Abstract;
 end;
 end;
 
 
+function TCustomCodeEditor.IsNestedComments(X,Y : sw_integer): boolean;
+begin
+  IsNestedComments:=false; {default behavior is no nested comments}
+end;
+
+function TCustomCodeEditor.NestedCommentsChangeCheck(CurLine : sw_integer):boolean;
+begin
+  NestedCommentsChangeCheck:=false;
+end;
+
 function TCustomCodeEditor.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
 function TCustomCodeEditor.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
 begin
 begin
   IsFlagSet:=(GetFlags and AFlag)=AFlag;
   IsFlagSet:=(GetFlags and AFlag)=AFlag;