View Issue Details

IDProjectCategoryView StatusLast Update
0030420LazarusPackagespublic2017-02-01 15:12
ReporterPascal RiekenbergAssigned ToMartin Friebe 
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
PlatformallOSallOS Versionall
Product Version1.7 (SVN)Product Build 
Target Version1.8Fixed in Version1.8 
Summary0030420: upgrade to Pascal highlighter: fold node for "else" part
Descriptionattached patch upgrades the Pascal highlighter to use fold nodes for
the "else" part as it will be needed for the outline coloring markup to show
vertical lines in front of the else part.
TagsNo tags attached.
Fixed in Revision54042
LazTarget1.8
Widgetset
Attached Files
  • else_for_pashighlighter_and_TSynFoldAction_for_coloring.patch (8,797 bytes)
    Index: synedithighlighterfoldbase.pas
    ===================================================================
    --- synedithighlighterfoldbase.pas	(revision 52753)
    +++ synedithighlighterfoldbase.pas	(working copy)
    @@ -81,7 +81,9 @@
                          sfaDefaultCollapsed,
                          sfaMarkup,   // This node can be highlighted, by the matching Word-Pair Markup
                          sfaOutline,  // This node will be higlighted by nested color replacing the token color
    -                     sfaOutlineKeepLevel, // Direct children should not increase color dept. (But grandchild can.)  e.g. "if","then" any "procedure"
    +                     sfaOutlineKeepLevel, // Direct children should not increase color dept. (But grandchild can.)  e.g. any "procedure"
    +                     sfaOutlineKeepLevelOnSameLine, // Direct children should not increase color dept. if they are on the same line (But grandchild can.)  e.g. "if/then" "do/while"
    +                     sfaOutlineMergeLevelOnWrongCol, // Keeps level if node starts on wrong column e.g. "if, else if, else if, else if, else, ;" with all else on same column
                          sfaOutlineMergeParent,// This node want to decrease current color depth. (But Previous sibling increased) e.g. "except", "finally"
                          sfaOutlineForceIndent, // Node will temporary ignore sfaOutlineKeep. (Next sibling can.) e.g in NESTED "procedure"
                          sfaOutlineNoColor,     // Node will not painted by nested-coloring, but may increase color (e.g. any "procedure")
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 52753)
    +++ synhighlighterpas.pp	(working copy)
    @@ -129,6 +129,7 @@
         cfbtForDo,
         cfbtWhileDo,
         cfbtWithDo,
    +    cfbtIfElse,
         // Internal type / not configurable
         cfbtCaseElse,     // "else" in case can have multiply statements
         cfbtPackage,
    @@ -139,7 +140,7 @@
     
     
     const
    -  cfbtLastPublic = cfbtWithDo;
    +  cfbtLastPublic = cfbtIfElse;
       cfbtFirstPrivate = cfbtCaseElse;
     
       CountPascalCodeFoldBlockOffset =
    @@ -152,7 +153,7 @@
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
          cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
          cfbtIfDef, cfbtRegion,
    -     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
    +     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
         ]);
       PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
         [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
    @@ -168,7 +169,7 @@
     
       PascalStatementBlocks = TPascalCodeFoldBlockTypes(
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
    -     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
     
       cfbtEssential = TPascalCodeFoldBlockTypes([
         cfbtClass, cfbtClassSection, cfbtRecord,
    @@ -181,7 +182,7 @@
         + ProcModifierAllowed + PascalStatementBlocks
         // the following statementblocks can only be nested in another statement.
         - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
    -       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
     
       PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
         ( cfbtBeginEnd,      // Nested
    @@ -211,6 +212,7 @@
           cfbtForDo,
           cfbtWhileDo,
           cfbtWithDo,
    +      cfbtIfElse,
           // Internal type / not configurable
           cfbtCaseElse,
           cfbtPackage,
    @@ -974,7 +976,7 @@
           // there may be more than on block ending here
           tfb := TopPascalCodeFoldBlockType;
           fStringLen:=0;
    -      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
    +      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
             EndPascalCodeFoldBlock(True);
             tfb := TopPascalCodeFoldBlockType;
           end;
    @@ -1007,7 +1009,7 @@
             if TopPascalCodeFoldBlockType = cfbtProgram then
               EndPascalCodeFoldBlock;
             fStringLen:=0;
    -        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
    +        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
               EndPascalCodeFoldBlock(True);
             end;
             fStringLen := sl;
    @@ -1173,9 +1175,14 @@
     begin
       if KeyComp('Else') then begin
         Result := tkKey;
    -    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
    -      EndPascalCodeFoldBlock
    -    else
    +    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
    +      // close all parent "else"
    +      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
    +        EndPascalCodeFoldBlock;
    +      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
    +        EndPascalCodeFoldBlock;
    +      StartPascalCodeFoldBlock(cfbtIfElse);
    +    end else
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           FTokenIsCaseLabel := True;
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -1496,7 +1503,7 @@
     begin
       if KeyComp('Except') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1522,7 +1529,7 @@
     begin
       if KeyComp('Until') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtRepeat);
         if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
    @@ -1534,7 +1541,7 @@
     begin
       if KeyComp('Finally') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1987,7 +1994,7 @@
     begin
       if KeyComp('Otherwise') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
           EndPascalCodeFoldBlock(True);
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -2978,7 +2985,7 @@
         EndPascalCodeFoldBlock(True);
     
       fStringLen:=0;
    -  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
    +  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
    @@ -3633,9 +3640,15 @@
       aActions := aActions + [sfaMultiLine];
     
       if (not FinishingABlock) and  (ABlockType <> nil) then begin
    -    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
    -      Include( aActions, sfaOutlineKeepLevel);
    +    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
    +      Include( aActions, sfaOutlineKeepLevelOnSameLine);
     
    +    if (PasBlockType in [cfbtIfElse]) then
    +      Include( aActions, sfaOutlineMergeLevelOnWrongCol);
    +
    +    if (PasBlockType in [cfbtClassSection]) then
    +      Include( aActions, sfaOutlineMergeParent);
    +
         if (PasBlockType in [cfbtProcedure]) then
           aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
     
    @@ -4101,7 +4114,7 @@
       case TPascalCodeFoldBlockType(Index) of
         cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
           m := [fmFold, fmHide] + m;
    -    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
    +    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
           m := m;
         cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
           m := [];
    @@ -4122,7 +4135,7 @@
     
       m := Result.SupportedModes;
     
    -  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
    +  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
         m := [];
       if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
         Result.Modes := [fmFold, fmHide] + m
    
  • synhighlighterpas.pp.patch (7,292 bytes)
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 52763)
    +++ synhighlighterpas.pp	(working copy)
    @@ -129,6 +129,7 @@
         cfbtForDo,
         cfbtWhileDo,
         cfbtWithDo,
    +    cfbtIfElse,
         // Internal type / not configurable
         cfbtCaseElse,     // "else" in case can have multiply statements
         cfbtPackage,
    @@ -139,7 +140,7 @@
     
     
     const
    -  cfbtLastPublic = cfbtWithDo;
    +  cfbtLastPublic = cfbtIfElse;
       cfbtFirstPrivate = cfbtCaseElse;
     
       CountPascalCodeFoldBlockOffset =
    @@ -152,7 +153,7 @@
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
          cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
          cfbtIfDef, cfbtRegion,
    -     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
    +     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
         ]);
       PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
         [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
    @@ -168,7 +169,7 @@
     
       PascalStatementBlocks = TPascalCodeFoldBlockTypes(
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
    -     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
     
       cfbtEssential = TPascalCodeFoldBlockTypes([
         cfbtClass, cfbtClassSection, cfbtRecord,
    @@ -181,7 +182,7 @@
         + ProcModifierAllowed + PascalStatementBlocks
         // the following statementblocks can only be nested in another statement.
         - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
    -       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
     
       PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
         ( cfbtBeginEnd,      // Nested
    @@ -211,6 +212,7 @@
           cfbtForDo,
           cfbtWhileDo,
           cfbtWithDo,
    +      cfbtIfElse,
           // Internal type / not configurable
           cfbtCaseElse,
           cfbtPackage,
    @@ -974,7 +976,7 @@
           // there may be more than on block ending here
           tfb := TopPascalCodeFoldBlockType;
           fStringLen:=0;
    -      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
    +      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
             EndPascalCodeFoldBlock(True);
             tfb := TopPascalCodeFoldBlockType;
           end;
    @@ -1007,7 +1009,7 @@
             if TopPascalCodeFoldBlockType = cfbtProgram then
               EndPascalCodeFoldBlock;
             fStringLen:=0;
    -        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
    +        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
               EndPascalCodeFoldBlock(True);
             end;
             fStringLen := sl;
    @@ -1173,9 +1175,14 @@
     begin
       if KeyComp('Else') then begin
         Result := tkKey;
    -    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
    -      EndPascalCodeFoldBlock
    -    else
    +    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
    +      // close all parent "else"
    +      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
    +        EndPascalCodeFoldBlock;
    +      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
    +        EndPascalCodeFoldBlock;
    +      StartPascalCodeFoldBlock(cfbtIfElse);
    +    end else
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           FTokenIsCaseLabel := True;
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -1496,7 +1503,7 @@
     begin
       if KeyComp('Except') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1522,7 +1529,7 @@
     begin
       if KeyComp('Until') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtRepeat);
         if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
    @@ -1534,7 +1541,7 @@
     begin
       if KeyComp('Finally') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1987,7 +1994,7 @@
     begin
       if KeyComp('Otherwise') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
           EndPascalCodeFoldBlock(True);
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -2978,7 +2985,7 @@
         EndPascalCodeFoldBlock(True);
     
       fStringLen:=0;
    -  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
    +  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
    @@ -3633,9 +3640,16 @@
       aActions := aActions + [sfaMultiLine];
     
       if (not FinishingABlock) and  (ABlockType <> nil) then begin
    -    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
    -      Include( aActions, sfaOutlineKeepLevel);
    +    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
    +    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
    +    Include( aActions, sfaOutlineKeepLevel);
     
    +    //if (PasBlockType in [cfbtIfElse]) then
    +    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
    +
    +    if (PasBlockType in [cfbtClassSection]) then
    +      Include( aActions, sfaOutlineMergeParent);
    +
         if (PasBlockType in [cfbtProcedure]) then
           aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
     
    @@ -4101,7 +4115,7 @@
       case TPascalCodeFoldBlockType(Index) of
         cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
           m := [fmFold, fmHide] + m;
    -    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
    +    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
           m := m;
         cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
           m := [];
    @@ -4122,7 +4136,7 @@
     
       m := Result.SupportedModes;
     
    -  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
    +  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
         m := [];
       if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
         Result.Modes := [fmFold, fmHide] + m
    
  • synhighlighterpas.pp_v2.patch (6,920 bytes)
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 54022)
    +++ synhighlighterpas.pp	(working copy)
    @@ -129,6 +129,7 @@
         cfbtForDo,
         cfbtWhileDo,
         cfbtWithDo,
    +    cfbtIfElse,
         // Internal type / not configurable
         cfbtCaseElse,     // "else" in case can have multiply statements
         cfbtPackage,
    @@ -139,7 +140,7 @@
     
     
     const
    -  cfbtLastPublic = cfbtWithDo;
    +  cfbtLastPublic = cfbtIfElse;
       cfbtFirstPrivate = cfbtCaseElse;
     
       CountPascalCodeFoldBlockOffset =
    @@ -152,7 +153,7 @@
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
          cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
          cfbtIfDef, cfbtRegion,
    -     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
    +     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
         ]);
       PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
         [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
    @@ -168,7 +169,7 @@
     
       PascalStatementBlocks = TPascalCodeFoldBlockTypes(
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
    -     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
     
       cfbtEssential = TPascalCodeFoldBlockTypes([
         cfbtClass, cfbtClassSection, cfbtRecord,
    @@ -181,7 +182,7 @@
         + ProcModifierAllowed + PascalStatementBlocks
         // the following statementblocks can only be nested in another statement.
         - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
    -       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
     
       PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
         ( cfbtBeginEnd,      // Nested
    @@ -211,6 +212,7 @@
           cfbtForDo,
           cfbtWhileDo,
           cfbtWithDo,
    +      cfbtIfElse,
           // Internal type / not configurable
           cfbtCaseElse,
           cfbtPackage,
    @@ -974,7 +976,7 @@
           // there may be more than on block ending here
           tfb := TopPascalCodeFoldBlockType;
           fStringLen:=0;
    -      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
    +      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
             EndPascalCodeFoldBlock(True);
             tfb := TopPascalCodeFoldBlockType;
           end;
    @@ -1007,7 +1009,7 @@
             if TopPascalCodeFoldBlockType = cfbtProgram then
               EndPascalCodeFoldBlock;
             fStringLen:=0;
    -        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
    +        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
               EndPascalCodeFoldBlock(True);
             end;
             fStringLen := sl;
    @@ -1173,9 +1175,14 @@
     begin
       if KeyComp('Else') then begin
         Result := tkKey;
    -    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
    -      EndPascalCodeFoldBlock
    -    else
    +    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
    +      // close all parent "then", "else" and "do"
    +      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
    +        EndPascalCodeFoldBlock;
    +      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
    +        EndPascalCodeFoldBlock;
    +      StartPascalCodeFoldBlock(cfbtIfElse);
    +    end else
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           FTokenIsCaseLabel := True;
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -1496,7 +1503,7 @@
     begin
       if KeyComp('Except') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1522,7 +1529,7 @@
     begin
       if KeyComp('Until') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtRepeat);
         if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
    @@ -1534,7 +1541,7 @@
     begin
       if KeyComp('Finally') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1987,7 +1994,7 @@
     begin
       if KeyComp('Otherwise') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
           EndPascalCodeFoldBlock(True);
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           StartPascalCodeFoldBlock(cfbtCaseElse);
    @@ -2978,7 +2985,7 @@
         EndPascalCodeFoldBlock(True);
     
       fStringLen:=0;
    -  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
    +  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
    @@ -3633,7 +3640,7 @@
       aActions := aActions + [sfaMultiLine];
     
       if (not FinishingABlock) and  (ABlockType <> nil) then begin
    -    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
    +    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
           Include( aActions, sfaOutlineKeepLevel);
     
         if (PasBlockType in [cfbtProcedure]) then
    @@ -4101,7 +4108,7 @@
       case TPascalCodeFoldBlockType(Index) of
         cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
           m := [fmFold, fmHide] + m;
    -    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
    +    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
           m := m;
         cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
           m := [];
    @@ -4122,7 +4129,7 @@
     
       m := Result.SupportedModes;
     
    -  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
    +  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
         m := [];
       if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
         Result.Modes := [fmFold, fmHide] + m
    
  • synhighlighterpas.pp_v3.patch (8,810 bytes)
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 54032)
    +++ synhighlighterpas.pp	(working copy)
    @@ -129,6 +129,7 @@
         cfbtForDo,
         cfbtWhileDo,
         cfbtWithDo,
    +    cfbtIfElse,
         // Internal type / not configurable
         cfbtCaseElse,     // "else" in case can have multiply statements
         cfbtPackage,
    @@ -139,7 +140,7 @@
     
     
     const
    -  cfbtLastPublic = cfbtWithDo;
    +  cfbtLastPublic = cfbtIfElse;
       cfbtFirstPrivate = cfbtCaseElse;
     
       CountPascalCodeFoldBlockOffset =
    @@ -152,7 +153,7 @@
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
          cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
          cfbtIfDef, cfbtRegion,
    -     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
    +     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
         ]);
       PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
         [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
    @@ -168,7 +169,7 @@
     
       PascalStatementBlocks = TPascalCodeFoldBlockTypes(
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
    -     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
     
       cfbtEssential = TPascalCodeFoldBlockTypes([
         cfbtClass, cfbtClassSection, cfbtRecord,
    @@ -181,7 +182,7 @@
         + ProcModifierAllowed + PascalStatementBlocks
         // the following statementblocks can only be nested in another statement.
         - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
    -       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
     
       PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
         ( cfbtBeginEnd,      // Nested
    @@ -211,6 +212,7 @@
           cfbtForDo,
           cfbtWhileDo,
           cfbtWithDo,
    +      cfbtIfElse,
           // Internal type / not configurable
           cfbtCaseElse,
           cfbtPackage,
    @@ -675,6 +677,12 @@
       IsUnderScoreOrNumberChar: array[char] of Boolean;
       IsLetterChar: array[char] of Boolean;
     
    +function FoldTypeToStr(p_FoldType: TPascalCodeFoldBlockType): String;
    +begin
    +  WriteStr(Result, p_FoldType);
    +  while length(Result) < 17 do Result := Result + ' ';
    +end;
    +
     procedure MakeIdentTable;
     var
       I, J: Char;
    @@ -974,7 +982,7 @@
           // there may be more than on block ending here
           tfb := TopPascalCodeFoldBlockType;
           fStringLen:=0;
    -      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
    +      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
             EndPascalCodeFoldBlock(True);
             tfb := TopPascalCodeFoldBlockType;
           end;
    @@ -1007,7 +1015,7 @@
             if TopPascalCodeFoldBlockType = cfbtProgram then
               EndPascalCodeFoldBlock;
             fStringLen:=0;
    -        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
    +        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
               EndPascalCodeFoldBlock(True);
             end;
             fStringLen := sl;
    @@ -1062,6 +1070,7 @@
         fRange := fRange + [rsAtPropertyOrReadWrite];
       end
       else if KeyComp('Case') then begin
    +    DebugLn('### Case');
         if TopPascalCodeFoldBlockType in PascalStatementBlocks + [cfbtUnitSection] then
           StartPascalCodeFoldBlock(cfbtCase);
         Result := tkKey;
    @@ -1173,13 +1182,25 @@
     begin
       if KeyComp('Else') then begin
         Result := tkKey;
    -    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
    -      EndPascalCodeFoldBlock
    -    else
    +    DebugLn('  ### Else');
    +    // close all parent "else" and "do"
    +    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
    +      DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
    +      EndPascalCodeFoldBlock;
    +    end;
    +    if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
    +      DebugLn('    -> IfElse');
    +      EndPascalCodeFoldBlock;
    +      StartPascalCodeFoldBlock(cfbtIfElse);
    +    end else
         if TopPascalCodeFoldBlockType = cfbtCase then begin
    +      DebugLn('    -> CaseElse');
           FTokenIsCaseLabel := True;
           StartPascalCodeFoldBlock(cfbtCaseElse);
    -    end;
    +    end
    +    else begin
    +      DebugLn('    -> Other: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
    +    end
       end
       else if KeyComp('Var') then begin
         if (PasCodeFoldRange.BracketNestLevel = 0) and
    @@ -1496,7 +1517,7 @@
     begin
       if KeyComp('Except') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1522,7 +1543,7 @@
     begin
       if KeyComp('Until') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtRepeat);
         if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
    @@ -1534,7 +1555,7 @@
     begin
       if KeyComp('Finally') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1987,8 +2008,11 @@
     begin
       if KeyComp('Otherwise') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
    +    DebugLn('  ### Otherwise');
    +    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfThen,cfbtIfElse]) do begin
    +      DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
           EndPascalCodeFoldBlock(True);
    +    end;
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           StartPascalCodeFoldBlock(cfbtCaseElse);
           FTokenIsCaseLabel := True;
    @@ -2422,7 +2446,7 @@
     
     procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer);
     begin
    -  //DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
    +  DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
       fLineStr := NewValue;
       fLineLen:=length(fLineStr);
       fLine:=PChar(Pointer(fLineStr));
    @@ -2978,7 +3002,7 @@
         EndPascalCodeFoldBlock(True);
     
       fStringLen:=0;
    -  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
    +  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
    @@ -3633,9 +3657,16 @@
       aActions := aActions + [sfaMultiLine];
     
       if (not FinishingABlock) and  (ABlockType <> nil) then begin
    -    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
    -      Include( aActions, sfaOutlineKeepLevel);
    +    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
    +    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
    +    Include( aActions, sfaOutlineKeepLevel);
     
    +    //if (PasBlockType in [cfbtIfElse]) then
    +    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
    +
    +    if (PasBlockType in [cfbtClassSection]) then
    +      Include( aActions, sfaOutlineMergeParent);
    +
         if (PasBlockType in [cfbtProcedure]) then
           aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
     
    @@ -4101,7 +4132,7 @@
       case TPascalCodeFoldBlockType(Index) of
         cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
           m := [fmFold, fmHide] + m;
    -    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
    +    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
           m := m;
         cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
           m := [];
    @@ -4122,7 +4153,7 @@
     
       m := Result.SupportedModes;
     
    -  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
    +  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
         m := [];
       if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
         Result.Modes := [fmFold, fmHide] + m
    
  • synhighlighterpas.pp_v4.patch (8,436 bytes)
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 54035)
    +++ synhighlighterpas.pp	(working copy)
    @@ -129,6 +129,7 @@
         cfbtForDo,
         cfbtWhileDo,
         cfbtWithDo,
    +    cfbtIfElse,
         // Internal type / not configurable
         cfbtCaseElse,     // "else" in case can have multiply statements
         cfbtPackage,
    @@ -139,7 +140,7 @@
     
     
     const
    -  cfbtLastPublic = cfbtWithDo;
    +  cfbtLastPublic = cfbtIfElse;
       cfbtFirstPrivate = cfbtCaseElse;
     
       CountPascalCodeFoldBlockOffset =
    @@ -152,7 +153,7 @@
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
          cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
          cfbtIfDef, cfbtRegion,
    -     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
    +     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
         ]);
       PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
         [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
    @@ -168,7 +169,7 @@
     
       PascalStatementBlocks = TPascalCodeFoldBlockTypes(
         [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
    -     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
     
       cfbtEssential = TPascalCodeFoldBlockTypes([
         cfbtClass, cfbtClassSection, cfbtRecord,
    @@ -181,7 +182,7 @@
         + ProcModifierAllowed + PascalStatementBlocks
         // the following statementblocks can only be nested in another statement.
         - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
    -       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
    +       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
     
       PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
         ( cfbtBeginEnd,      // Nested
    @@ -211,6 +212,7 @@
           cfbtForDo,
           cfbtWhileDo,
           cfbtWithDo,
    +      cfbtIfElse,
           // Internal type / not configurable
           cfbtCaseElse,
           cfbtPackage,
    @@ -675,6 +677,11 @@
       IsUnderScoreOrNumberChar: array[char] of Boolean;
       IsLetterChar: array[char] of Boolean;
     
    +function FoldTypeToStr(FoldType: TPascalCodeFoldBlockType): String;
    +begin
    +  WriteStr(Result, FoldType);
    +end;
    +
     procedure MakeIdentTable;
     var
       I, J: Char;
    @@ -974,7 +981,7 @@
           // there may be more than on block ending here
           tfb := TopPascalCodeFoldBlockType;
           fStringLen:=0;
    -      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
    +      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
             EndPascalCodeFoldBlock(True);
             tfb := TopPascalCodeFoldBlockType;
           end;
    @@ -1007,7 +1014,7 @@
             if TopPascalCodeFoldBlockType = cfbtProgram then
               EndPascalCodeFoldBlock;
             fStringLen:=0;
    -        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
    +        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
               EndPascalCodeFoldBlock(True);
             end;
             fStringLen := sl;
    @@ -1062,6 +1069,7 @@
         fRange := fRange + [rsAtPropertyOrReadWrite];
       end
       else if KeyComp('Case') then begin
    +    //DebugLn('### Case');
         if TopPascalCodeFoldBlockType in PascalStatementBlocks + [cfbtUnitSection] then
           StartPascalCodeFoldBlock(cfbtCase);
         Result := tkKey;
    @@ -1173,13 +1181,25 @@
     begin
       if KeyComp('Else') then begin
         Result := tkKey;
    -    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
    -      EndPascalCodeFoldBlock
    -    else
    +    //DebugLn('  ### Else');
    +    // close all parent "else" and "do"
    +    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
    +      //DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
    +      EndPascalCodeFoldBlockLastLine;
    +    end;
    +    if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
    +      //DebugLn('    -> IfElse');
    +      EndPascalCodeFoldBlock;
    +      StartPascalCodeFoldBlock(cfbtIfElse);
    +    end else
         if TopPascalCodeFoldBlockType = cfbtCase then begin
    +      //DebugLn('    -> CaseElse');
           FTokenIsCaseLabel := True;
           StartPascalCodeFoldBlock(cfbtCaseElse);
    -    end;
    +    end
    +    else begin
    +      //DebugLn('    -> Other: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
    +    end
       end
       else if KeyComp('Var') then begin
         if (PasCodeFoldRange.BracketNestLevel = 0) and
    @@ -1496,7 +1516,7 @@
     begin
       if KeyComp('Except') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1522,7 +1542,7 @@
     begin
       if KeyComp('Until') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtRepeat);
         if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
    @@ -1534,7 +1554,7 @@
     begin
       if KeyComp('Finally') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
    +    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
           EndPascalCodeFoldBlock(True);
         SmartCloseBeginEndBlocks(cfbtTry);
         if TopPascalCodeFoldBlockType = cfbtTry then
    @@ -1987,8 +2007,11 @@
     begin
       if KeyComp('Otherwise') then begin
         Result := tkKey;
    -    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
    -      EndPascalCodeFoldBlock(True);
    +    //DebugLn('  ### Otherwise');
    +    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfThen,cfbtIfElse]) do begin
    +      //DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
    +      EndPascalCodeFoldBlockLastLine;
    +    end;
         if TopPascalCodeFoldBlockType = cfbtCase then begin
           StartPascalCodeFoldBlock(cfbtCaseElse);
           FTokenIsCaseLabel := True;
    @@ -2978,7 +3001,7 @@
         EndPascalCodeFoldBlock(True);
     
       fStringLen:=0;
    -  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
    +  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
    @@ -3633,9 +3656,16 @@
       aActions := aActions + [sfaMultiLine];
     
       if (not FinishingABlock) and  (ABlockType <> nil) then begin
    -    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
    -      Include( aActions, sfaOutlineKeepLevel);
    +    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
    +    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
    +    Include( aActions, sfaOutlineKeepLevel);
     
    +    //if (PasBlockType in [cfbtIfElse]) then
    +    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
    +
    +    if (PasBlockType in [cfbtClassSection]) then
    +      Include( aActions, sfaOutlineMergeParent);
    +
         if (PasBlockType in [cfbtProcedure]) then
           aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
     
    @@ -4101,7 +4131,7 @@
       case TPascalCodeFoldBlockType(Index) of
         cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
           m := [fmFold, fmHide] + m;
    -    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
    +    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
           m := m;
         cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
           m := [];
    @@ -4122,7 +4152,7 @@
     
       m := Result.SupportedModes;
     
    -  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
    +  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
         m := [];
       if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
         Result.Modes := [fmFold, fmHide] + m
    
  • synhighlighterpas.pp_v5.patch (732 bytes)
    Index: synhighlighterpas.pp
    ===================================================================
    --- synhighlighterpas.pp	(revision 54045)
    +++ synhighlighterpas.pp	(working copy)
    @@ -1183,7 +1183,10 @@
         // close all parent "else" and "do" // there can only be one else
         while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
           //DebugLn('    Ending: %s', [dbgs(TopPascalCodeFoldBlockType)]);
    -      EndPascalCodeFoldBlockLastLine;
    +      if TopPascalCodeFoldBlockType(1) = cfbtCase then
    +        EndPascalCodeFoldBlockLastLine
    +      else
    +        EndPascalCodeFoldBlock;
         end;
         if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
           EndPascalCodeFoldBlock;
    

Relationships

child of 0030421 closedMartin Friebe Update to TSynEditMarkupFoldColors including correct invalidation 

Activities

Pascal Riekenberg

2016-07-29 09:47

reporter  

else_for_pashighlighter_and_TSynFoldAction_for_coloring.patch (8,797 bytes)
Index: synedithighlighterfoldbase.pas
===================================================================
--- synedithighlighterfoldbase.pas	(revision 52753)
+++ synedithighlighterfoldbase.pas	(working copy)
@@ -81,7 +81,9 @@
                      sfaDefaultCollapsed,
                      sfaMarkup,   // This node can be highlighted, by the matching Word-Pair Markup
                      sfaOutline,  // This node will be higlighted by nested color replacing the token color
-                     sfaOutlineKeepLevel, // Direct children should not increase color dept. (But grandchild can.)  e.g. "if","then" any "procedure"
+                     sfaOutlineKeepLevel, // Direct children should not increase color dept. (But grandchild can.)  e.g. any "procedure"
+                     sfaOutlineKeepLevelOnSameLine, // Direct children should not increase color dept. if they are on the same line (But grandchild can.)  e.g. "if/then" "do/while"
+                     sfaOutlineMergeLevelOnWrongCol, // Keeps level if node starts on wrong column e.g. "if, else if, else if, else if, else, ;" with all else on same column
                      sfaOutlineMergeParent,// This node want to decrease current color depth. (But Previous sibling increased) e.g. "except", "finally"
                      sfaOutlineForceIndent, // Node will temporary ignore sfaOutlineKeep. (Next sibling can.) e.g in NESTED "procedure"
                      sfaOutlineNoColor,     // Node will not painted by nested-coloring, but may increase color (e.g. any "procedure")
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 52753)
+++ synhighlighterpas.pp	(working copy)
@@ -129,6 +129,7 @@
     cfbtForDo,
     cfbtWhileDo,
     cfbtWithDo,
+    cfbtIfElse,
     // Internal type / not configurable
     cfbtCaseElse,     // "else" in case can have multiply statements
     cfbtPackage,
@@ -139,7 +140,7 @@
 
 
 const
-  cfbtLastPublic = cfbtWithDo;
+  cfbtLastPublic = cfbtIfElse;
   cfbtFirstPrivate = cfbtCaseElse;
 
   CountPascalCodeFoldBlockOffset =
@@ -152,7 +153,7 @@
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
      cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
      cfbtIfDef, cfbtRegion,
-     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
+     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
     ]);
   PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
     [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
@@ -168,7 +169,7 @@
 
   PascalStatementBlocks = TPascalCodeFoldBlockTypes(
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
-     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
 
   cfbtEssential = TPascalCodeFoldBlockTypes([
     cfbtClass, cfbtClassSection, cfbtRecord,
@@ -181,7 +182,7 @@
     + ProcModifierAllowed + PascalStatementBlocks
     // the following statementblocks can only be nested in another statement.
     - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
-       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
 
   PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
     ( cfbtBeginEnd,      // Nested
@@ -211,6 +212,7 @@
       cfbtForDo,
       cfbtWhileDo,
       cfbtWithDo,
+      cfbtIfElse,
       // Internal type / not configurable
       cfbtCaseElse,
       cfbtPackage,
@@ -974,7 +976,7 @@
       // there may be more than on block ending here
       tfb := TopPascalCodeFoldBlockType;
       fStringLen:=0;
-      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
+      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
@@ -1007,7 +1009,7 @@
         if TopPascalCodeFoldBlockType = cfbtProgram then
           EndPascalCodeFoldBlock;
         fStringLen:=0;
-        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
+        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
           EndPascalCodeFoldBlock(True);
         end;
         fStringLen := sl;
@@ -1173,9 +1175,14 @@
 begin
   if KeyComp('Else') then begin
     Result := tkKey;
-    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
-      EndPascalCodeFoldBlock
-    else
+    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
+      // close all parent "else"
+      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
+        EndPascalCodeFoldBlock;
+      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
+        EndPascalCodeFoldBlock;
+      StartPascalCodeFoldBlock(cfbtIfElse);
+    end else
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       FTokenIsCaseLabel := True;
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -1496,7 +1503,7 @@
 begin
   if KeyComp('Except') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1522,7 +1529,7 @@
 begin
   if KeyComp('Until') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtRepeat);
     if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
@@ -1534,7 +1541,7 @@
 begin
   if KeyComp('Finally') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1987,7 +1994,7 @@
 begin
   if KeyComp('Otherwise') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
       EndPascalCodeFoldBlock(True);
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -2978,7 +2985,7 @@
     EndPascalCodeFoldBlock(True);
 
   fStringLen:=0;
-  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
+  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
     EndPascalCodeFoldBlock(True);
     tfb := TopPascalCodeFoldBlockType;
   end;
@@ -3633,9 +3640,15 @@
   aActions := aActions + [sfaMultiLine];
 
   if (not FinishingABlock) and  (ABlockType <> nil) then begin
-    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
-      Include( aActions, sfaOutlineKeepLevel);
+    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
+      Include( aActions, sfaOutlineKeepLevelOnSameLine);
 
+    if (PasBlockType in [cfbtIfElse]) then
+      Include( aActions, sfaOutlineMergeLevelOnWrongCol);
+
+    if (PasBlockType in [cfbtClassSection]) then
+      Include( aActions, sfaOutlineMergeParent);
+
     if (PasBlockType in [cfbtProcedure]) then
       aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
 
@@ -4101,7 +4114,7 @@
   case TPascalCodeFoldBlockType(Index) of
     cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
       m := [fmFold, fmHide] + m;
-    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
+    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
       m := m;
     cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
       m := [];
@@ -4122,7 +4135,7 @@
 
   m := Result.SupportedModes;
 
-  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
+  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
     m := [];
   if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
     Result.Modes := [fmFold, fmHide] + m

Pascal Riekenberg

2016-08-01 13:27

reporter  

synhighlighterpas.pp.patch (7,292 bytes)
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 52763)
+++ synhighlighterpas.pp	(working copy)
@@ -129,6 +129,7 @@
     cfbtForDo,
     cfbtWhileDo,
     cfbtWithDo,
+    cfbtIfElse,
     // Internal type / not configurable
     cfbtCaseElse,     // "else" in case can have multiply statements
     cfbtPackage,
@@ -139,7 +140,7 @@
 
 
 const
-  cfbtLastPublic = cfbtWithDo;
+  cfbtLastPublic = cfbtIfElse;
   cfbtFirstPrivate = cfbtCaseElse;
 
   CountPascalCodeFoldBlockOffset =
@@ -152,7 +153,7 @@
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
      cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
      cfbtIfDef, cfbtRegion,
-     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
+     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
     ]);
   PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
     [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
@@ -168,7 +169,7 @@
 
   PascalStatementBlocks = TPascalCodeFoldBlockTypes(
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
-     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
 
   cfbtEssential = TPascalCodeFoldBlockTypes([
     cfbtClass, cfbtClassSection, cfbtRecord,
@@ -181,7 +182,7 @@
     + ProcModifierAllowed + PascalStatementBlocks
     // the following statementblocks can only be nested in another statement.
     - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
-       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
 
   PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
     ( cfbtBeginEnd,      // Nested
@@ -211,6 +212,7 @@
       cfbtForDo,
       cfbtWhileDo,
       cfbtWithDo,
+      cfbtIfElse,
       // Internal type / not configurable
       cfbtCaseElse,
       cfbtPackage,
@@ -974,7 +976,7 @@
       // there may be more than on block ending here
       tfb := TopPascalCodeFoldBlockType;
       fStringLen:=0;
-      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
+      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
@@ -1007,7 +1009,7 @@
         if TopPascalCodeFoldBlockType = cfbtProgram then
           EndPascalCodeFoldBlock;
         fStringLen:=0;
-        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
+        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
           EndPascalCodeFoldBlock(True);
         end;
         fStringLen := sl;
@@ -1173,9 +1175,14 @@
 begin
   if KeyComp('Else') then begin
     Result := tkKey;
-    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
-      EndPascalCodeFoldBlock
-    else
+    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
+      // close all parent "else"
+      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
+        EndPascalCodeFoldBlock;
+      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
+        EndPascalCodeFoldBlock;
+      StartPascalCodeFoldBlock(cfbtIfElse);
+    end else
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       FTokenIsCaseLabel := True;
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -1496,7 +1503,7 @@
 begin
   if KeyComp('Except') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1522,7 +1529,7 @@
 begin
   if KeyComp('Until') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtRepeat);
     if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
@@ -1534,7 +1541,7 @@
 begin
   if KeyComp('Finally') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1987,7 +1994,7 @@
 begin
   if KeyComp('Otherwise') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
       EndPascalCodeFoldBlock(True);
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -2978,7 +2985,7 @@
     EndPascalCodeFoldBlock(True);
 
   fStringLen:=0;
-  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
+  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
     EndPascalCodeFoldBlock(True);
     tfb := TopPascalCodeFoldBlockType;
   end;
@@ -3633,9 +3640,16 @@
   aActions := aActions + [sfaMultiLine];
 
   if (not FinishingABlock) and  (ABlockType <> nil) then begin
-    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
-      Include( aActions, sfaOutlineKeepLevel);
+    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
+    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
+    Include( aActions, sfaOutlineKeepLevel);
 
+    //if (PasBlockType in [cfbtIfElse]) then
+    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
+
+    if (PasBlockType in [cfbtClassSection]) then
+      Include( aActions, sfaOutlineMergeParent);
+
     if (PasBlockType in [cfbtProcedure]) then
       aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
 
@@ -4101,7 +4115,7 @@
   case TPascalCodeFoldBlockType(Index) of
     cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
       m := [fmFold, fmHide] + m;
-    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
+    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
       m := m;
     cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
       m := [];
@@ -4122,7 +4136,7 @@
 
   m := Result.SupportedModes;
 
-  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
+  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
     m := [];
   if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
     Result.Modes := [fmFold, fmHide] + m

Pascal Riekenberg

2016-08-01 13:29

reporter   ~0093940

Martin,

the latest patch only has the else part. Nothing else (at least commented out)

Pascal Riekenberg

2017-01-28 07:05

reporter  

synhighlighterpas.pp_v2.patch (6,920 bytes)
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 54022)
+++ synhighlighterpas.pp	(working copy)
@@ -129,6 +129,7 @@
     cfbtForDo,
     cfbtWhileDo,
     cfbtWithDo,
+    cfbtIfElse,
     // Internal type / not configurable
     cfbtCaseElse,     // "else" in case can have multiply statements
     cfbtPackage,
@@ -139,7 +140,7 @@
 
 
 const
-  cfbtLastPublic = cfbtWithDo;
+  cfbtLastPublic = cfbtIfElse;
   cfbtFirstPrivate = cfbtCaseElse;
 
   CountPascalCodeFoldBlockOffset =
@@ -152,7 +153,7 @@
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
      cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
      cfbtIfDef, cfbtRegion,
-     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
+     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
     ]);
   PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
     [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
@@ -168,7 +169,7 @@
 
   PascalStatementBlocks = TPascalCodeFoldBlockTypes(
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
-     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
 
   cfbtEssential = TPascalCodeFoldBlockTypes([
     cfbtClass, cfbtClassSection, cfbtRecord,
@@ -181,7 +182,7 @@
     + ProcModifierAllowed + PascalStatementBlocks
     // the following statementblocks can only be nested in another statement.
     - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
-       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
 
   PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
     ( cfbtBeginEnd,      // Nested
@@ -211,6 +212,7 @@
       cfbtForDo,
       cfbtWhileDo,
       cfbtWithDo,
+      cfbtIfElse,
       // Internal type / not configurable
       cfbtCaseElse,
       cfbtPackage,
@@ -974,7 +976,7 @@
       // there may be more than on block ending here
       tfb := TopPascalCodeFoldBlockType;
       fStringLen:=0;
-      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
+      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
@@ -1007,7 +1009,7 @@
         if TopPascalCodeFoldBlockType = cfbtProgram then
           EndPascalCodeFoldBlock;
         fStringLen:=0;
-        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
+        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
           EndPascalCodeFoldBlock(True);
         end;
         fStringLen := sl;
@@ -1173,9 +1175,14 @@
 begin
   if KeyComp('Else') then begin
     Result := tkKey;
-    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
-      EndPascalCodeFoldBlock
-    else
+    if (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then begin
+      // close all parent "then", "else" and "do"
+      while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do
+        EndPascalCodeFoldBlock;
+      if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then
+        EndPascalCodeFoldBlock;
+      StartPascalCodeFoldBlock(cfbtIfElse);
+    end else
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       FTokenIsCaseLabel := True;
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -1496,7 +1503,7 @@
 begin
   if KeyComp('Except') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1522,7 +1529,7 @@
 begin
   if KeyComp('Until') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtRepeat);
     if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
@@ -1534,7 +1541,7 @@
 begin
   if KeyComp('Finally') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1987,7 +1994,7 @@
 begin
   if KeyComp('Otherwise') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do
       EndPascalCodeFoldBlock(True);
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       StartPascalCodeFoldBlock(cfbtCaseElse);
@@ -2978,7 +2985,7 @@
     EndPascalCodeFoldBlock(True);
 
   fStringLen:=0;
-  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
+  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
     EndPascalCodeFoldBlock(True);
     tfb := TopPascalCodeFoldBlockType;
   end;
@@ -3633,7 +3640,7 @@
   aActions := aActions + [sfaMultiLine];
 
   if (not FinishingABlock) and  (ABlockType <> nil) then begin
-    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
+    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
       Include( aActions, sfaOutlineKeepLevel);
 
     if (PasBlockType in [cfbtProcedure]) then
@@ -4101,7 +4108,7 @@
   case TPascalCodeFoldBlockType(Index) of
     cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
       m := [fmFold, fmHide] + m;
-    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
+    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
       m := m;
     cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
       m := [];
@@ -4122,7 +4129,7 @@
 
   m := Result.SupportedModes;
 
-  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
+  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
     m := [];
   if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
     Result.Modes := [fmFold, fmHide] + m

Pascal Riekenberg

2017-01-28 07:07

reporter   ~0097759

Martin, ignore the first two patches.
All things needed for "else as foldnode" is in v2 patch

Martin Friebe

2017-01-29 17:48

manager   ~0097787

Unfortunately this breaks case ... else

  case a of
    1: if b then bar else abc
    else foo;
  end
  case a of
    1: if b then if c then b else y
    else abc
    else foo;
  end

In both "case" the last "else" does not belong to the "if" but to the "case"
If case identifiers have a highlight, this should be highlighted.

It is correct and intend that there are no semicolon.

Martin Friebe

2017-01-29 17:56

manager   ~0097788

Last edited: 2017-01-29 18:05

View 2 revisions

also test with
  case a of
    1: if b then bar
    else if c then b else y
    else foo;
  end

  case a of
    1: if b then if c then bar
    else foo
    otherwise foo
  end


--------------------
And what to do about IDE config?
IDE config should NOT show a separate entry for "else", it should enable/disable "else" according to the state of "if"

The HL can have 2 individual settings, that is ok. But all GUI must abstract this

Pascal Riekenberg

2017-01-30 07:31

reporter   ~0097802

Last edited: 2017-01-30 11:30

View 4 revisions

How have you seen this? I did a test on plain trunk and it looks the same to me.

"If case identifiers have a highlight, this should be highlighted.": Which highlight do you mean? Word Brakets? Then onyl "case", "of" and "end" are highlighted. Same with plain trunk.

-------------
"And what to do about IDE config?
IDE config should NOT show a separate entry for "else", it should enable/disable "else" according to the state of "if"

The HL can have 2 individual settings, that is ok. But all GUI must abstract this": I agree. GUI should abstract it.

Pascal Riekenberg

2017-01-30 08:45

reporter   ~0097805

Last edited: 2017-01-30 09:40

View 2 revisions

btw: "else" and "otherwise" also have to end "do"
---
I had a little bug, which i fixed ("else" first ends all "do" and "else" and then checks if it belongs to "then" or "case")
---
I've uploaded a new patch with some DebugLn for "case", "else" and "otherwise" and aktivated SetLine() DebugLn.
The output of your sample looks okay:

TSynPasSyn.SetLine START LineNumber=0 Line="begin"
TSynPasSyn.SetLine START LineNumber=1 Line=" case a of"
### Case
TSynPasSyn.SetLine START LineNumber=2 Line=" 1: if b then bar else abc"
  ### Else
    -> IfElse
TSynPasSyn.SetLine START LineNumber=3 Line=" else foo;"
  ### Else
    Ending: cfbtIfElse
    -> CaseElse
TSynPasSyn.SetLine START LineNumber=4 Line=" end"
TSynPasSyn.SetLine START LineNumber=5 Line=" case a of"
### Case
TSynPasSyn.SetLine START LineNumber=6 Line=" 1: if b then if c then b else y"
  ### Else
    -> IfElse
TSynPasSyn.SetLine START LineNumber=7 Line=" else abc"
  ### Else
    Ending: cfbtIfElse
    -> IfElse
TSynPasSyn.SetLine START LineNumber=8 Line=" else foo;"
  ### Else
    Ending: cfbtIfElse
    -> CaseElse
TSynPasSyn.SetLine START LineNumber=9 Line=" end;"
TSynPasSyn.SetLine START LineNumber=10 Line=" case a of"
### Case
TSynPasSyn.SetLine START LineNumber=11 Line=" 1: if b then bar"
TSynPasSyn.SetLine START LineNumber=12 Line=" else if c then b else y"
  ### Else
    -> IfElse
  ### Else
    -> IfElse
TSynPasSyn.SetLine START LineNumber=13 Line=" else foo;"
  ### Else
    Ending: cfbtIfElse
    Ending: cfbtIfElse
    -> CaseElse
TSynPasSyn.SetLine START LineNumber=14 Line=" end"
TSynPasSyn.SetLine START LineNumber=15 Line=" case a of"
### Case
TSynPasSyn.SetLine START LineNumber=16 Line=" 1: if b then if c then bar"
TSynPasSyn.SetLine START LineNumber=17 Line=" else foo"
  ### Else
    -> IfElse
TSynPasSyn.SetLine START LineNumber=18 Line=" otherwise foo"
  ### Otherwise
    Ending: cfbtIfElse
    Ending: cfbtIfThen
TSynPasSyn.SetLine START LineNumber=19 Line=" end"
TSynPasSyn.SetLine START LineNumber=20 Line="end;"

Pascal Riekenberg

2017-01-30 08:47

reporter  

synhighlighterpas.pp_v3.patch (8,810 bytes)
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 54032)
+++ synhighlighterpas.pp	(working copy)
@@ -129,6 +129,7 @@
     cfbtForDo,
     cfbtWhileDo,
     cfbtWithDo,
+    cfbtIfElse,
     // Internal type / not configurable
     cfbtCaseElse,     // "else" in case can have multiply statements
     cfbtPackage,
@@ -139,7 +140,7 @@
 
 
 const
-  cfbtLastPublic = cfbtWithDo;
+  cfbtLastPublic = cfbtIfElse;
   cfbtFirstPrivate = cfbtCaseElse;
 
   CountPascalCodeFoldBlockOffset =
@@ -152,7 +153,7 @@
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
      cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
      cfbtIfDef, cfbtRegion,
-     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
+     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
     ]);
   PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
     [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
@@ -168,7 +169,7 @@
 
   PascalStatementBlocks = TPascalCodeFoldBlockTypes(
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
-     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
 
   cfbtEssential = TPascalCodeFoldBlockTypes([
     cfbtClass, cfbtClassSection, cfbtRecord,
@@ -181,7 +182,7 @@
     + ProcModifierAllowed + PascalStatementBlocks
     // the following statementblocks can only be nested in another statement.
     - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
-       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
 
   PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
     ( cfbtBeginEnd,      // Nested
@@ -211,6 +212,7 @@
       cfbtForDo,
       cfbtWhileDo,
       cfbtWithDo,
+      cfbtIfElse,
       // Internal type / not configurable
       cfbtCaseElse,
       cfbtPackage,
@@ -675,6 +677,12 @@
   IsUnderScoreOrNumberChar: array[char] of Boolean;
   IsLetterChar: array[char] of Boolean;
 
+function FoldTypeToStr(p_FoldType: TPascalCodeFoldBlockType): String;
+begin
+  WriteStr(Result, p_FoldType);
+  while length(Result) < 17 do Result := Result + ' ';
+end;
+
 procedure MakeIdentTable;
 var
   I, J: Char;
@@ -974,7 +982,7 @@
       // there may be more than on block ending here
       tfb := TopPascalCodeFoldBlockType;
       fStringLen:=0;
-      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
+      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
@@ -1007,7 +1015,7 @@
         if TopPascalCodeFoldBlockType = cfbtProgram then
           EndPascalCodeFoldBlock;
         fStringLen:=0;
-        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
+        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
           EndPascalCodeFoldBlock(True);
         end;
         fStringLen := sl;
@@ -1062,6 +1070,7 @@
     fRange := fRange + [rsAtPropertyOrReadWrite];
   end
   else if KeyComp('Case') then begin
+    DebugLn('### Case');
     if TopPascalCodeFoldBlockType in PascalStatementBlocks + [cfbtUnitSection] then
       StartPascalCodeFoldBlock(cfbtCase);
     Result := tkKey;
@@ -1173,13 +1182,25 @@
 begin
   if KeyComp('Else') then begin
     Result := tkKey;
-    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
-      EndPascalCodeFoldBlock
-    else
+    DebugLn('  ### Else');
+    // close all parent "else" and "do"
+    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
+      DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
+      EndPascalCodeFoldBlock;
+    end;
+    if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
+      DebugLn('    -> IfElse');
+      EndPascalCodeFoldBlock;
+      StartPascalCodeFoldBlock(cfbtIfElse);
+    end else
     if TopPascalCodeFoldBlockType = cfbtCase then begin
+      DebugLn('    -> CaseElse');
       FTokenIsCaseLabel := True;
       StartPascalCodeFoldBlock(cfbtCaseElse);
-    end;
+    end
+    else begin
+      DebugLn('    -> Other: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
+    end
   end
   else if KeyComp('Var') then begin
     if (PasCodeFoldRange.BracketNestLevel = 0) and
@@ -1496,7 +1517,7 @@
 begin
   if KeyComp('Except') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1522,7 +1543,7 @@
 begin
   if KeyComp('Until') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtRepeat);
     if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
@@ -1534,7 +1555,7 @@
 begin
   if KeyComp('Finally') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1987,8 +2008,11 @@
 begin
   if KeyComp('Otherwise') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
+    DebugLn('  ### Otherwise');
+    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfThen,cfbtIfElse]) do begin
+      DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
       EndPascalCodeFoldBlock(True);
+    end;
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       StartPascalCodeFoldBlock(cfbtCaseElse);
       FTokenIsCaseLabel := True;
@@ -2422,7 +2446,7 @@
 
 procedure TSynPasSyn.SetLine(const NewValue: string; LineNumber:Integer);
 begin
-  //DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
+  DebugLn(['TSynPasSyn.SetLine START LineNumber=',LineNumber,' Line="',NewValue,'"']);
   fLineStr := NewValue;
   fLineLen:=length(fLineStr);
   fLine:=PChar(Pointer(fLineStr));
@@ -2978,7 +3002,7 @@
     EndPascalCodeFoldBlock(True);
 
   fStringLen:=0;
-  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
+  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
     EndPascalCodeFoldBlock(True);
     tfb := TopPascalCodeFoldBlockType;
   end;
@@ -3633,9 +3657,16 @@
   aActions := aActions + [sfaMultiLine];
 
   if (not FinishingABlock) and  (ABlockType <> nil) then begin
-    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
-      Include( aActions, sfaOutlineKeepLevel);
+    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
+    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
+    Include( aActions, sfaOutlineKeepLevel);
 
+    //if (PasBlockType in [cfbtIfElse]) then
+    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
+
+    if (PasBlockType in [cfbtClassSection]) then
+      Include( aActions, sfaOutlineMergeParent);
+
     if (PasBlockType in [cfbtProcedure]) then
       aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
 
@@ -4101,7 +4132,7 @@
   case TPascalCodeFoldBlockType(Index) of
     cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
       m := [fmFold, fmHide] + m;
-    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
+    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
       m := m;
     cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
       m := [];
@@ -4122,7 +4153,7 @@
 
   m := Result.SupportedModes;
 
-  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
+  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
     m := [];
   if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
     Result.Modes := [fmFold, fmHide] + m

Pascal Riekenberg

2017-01-30 08:51

reporter   ~0097806

Last edited: 2017-01-30 08:52

View 2 revisions

TSynEditMarkupFoldColors seems to not work correctly with CaseElse and Otherwise

Pascal Riekenberg

2017-01-30 14:28

reporter  

synhighlighterpas.pp_v4.patch (8,436 bytes)
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 54035)
+++ synhighlighterpas.pp	(working copy)
@@ -129,6 +129,7 @@
     cfbtForDo,
     cfbtWhileDo,
     cfbtWithDo,
+    cfbtIfElse,
     // Internal type / not configurable
     cfbtCaseElse,     // "else" in case can have multiply statements
     cfbtPackage,
@@ -139,7 +140,7 @@
 
 
 const
-  cfbtLastPublic = cfbtWithDo;
+  cfbtLastPublic = cfbtIfElse;
   cfbtFirstPrivate = cfbtCaseElse;
 
   CountPascalCodeFoldBlockOffset =
@@ -152,7 +153,7 @@
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtProcedure, cfbtClass, cfbtProgram, cfbtRecord,
      cfbtTry, cfbtExcept, cfbtRepeat, cfbtAsm, cfbtCase, cfbtCaseElse,
      cfbtIfDef, cfbtRegion,
-     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo
+     cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse
     ]);
   PascalNoOutlineRanges = TPascalCodeFoldBlockTypes(
     [cfbtProgram,cfbtUnit,cfbtUnitSection, cfbtRegion, //cfbtProcedure,//=need by nested proc?
@@ -168,7 +169,7 @@
 
   PascalStatementBlocks = TPascalCodeFoldBlockTypes(
     [cfbtBeginEnd, cfbtTopBeginEnd, cfbtCase, cfbtTry, cfbtExcept, cfbtRepeat,
-     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+     cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse ]);
 
   cfbtEssential = TPascalCodeFoldBlockTypes([
     cfbtClass, cfbtClassSection, cfbtRecord,
@@ -181,7 +182,7 @@
     + ProcModifierAllowed + PascalStatementBlocks
     // the following statementblocks can only be nested in another statement.
     - [cfbtBeginEnd, cfbtCase, {cfbtTry,} cfbtExcept, cfbtRepeat,
-       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo ]);
+       cfbtCaseElse, cfbtIfThen, cfbtForDo,cfbtWhileDo,cfbtWithDo, cfbtIfElse ]);
 
   PascalFoldTypeCompatibility: Array [TPascalCodeFoldBlockType] of TPascalCodeFoldBlockType =
     ( cfbtBeginEnd,      // Nested
@@ -211,6 +212,7 @@
       cfbtForDo,
       cfbtWhileDo,
       cfbtWithDo,
+      cfbtIfElse,
       // Internal type / not configurable
       cfbtCaseElse,
       cfbtPackage,
@@ -675,6 +677,11 @@
   IsUnderScoreOrNumberChar: array[char] of Boolean;
   IsLetterChar: array[char] of Boolean;
 
+function FoldTypeToStr(FoldType: TPascalCodeFoldBlockType): String;
+begin
+  WriteStr(Result, FoldType);
+end;
+
 procedure MakeIdentTable;
 var
   I, J: Char;
@@ -974,7 +981,7 @@
       // there may be more than on block ending here
       tfb := TopPascalCodeFoldBlockType;
       fStringLen:=0;
-      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon before end
+      while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin // no semicolon before end
         EndPascalCodeFoldBlock(True);
         tfb := TopPascalCodeFoldBlockType;
       end;
@@ -1007,7 +1014,7 @@
         if TopPascalCodeFoldBlockType = cfbtProgram then
           EndPascalCodeFoldBlock;
         fStringLen:=0;
-        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
+        while (TopPascalCodeFoldBlockType in [{cfbtIfThen,}cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin // no semicolon after end
           EndPascalCodeFoldBlock(True);
         end;
         fStringLen := sl;
@@ -1062,6 +1069,7 @@
     fRange := fRange + [rsAtPropertyOrReadWrite];
   end
   else if KeyComp('Case') then begin
+    //DebugLn('### Case');
     if TopPascalCodeFoldBlockType in PascalStatementBlocks + [cfbtUnitSection] then
       StartPascalCodeFoldBlock(cfbtCase);
     Result := tkKey;
@@ -1173,13 +1181,25 @@
 begin
   if KeyComp('Else') then begin
     Result := tkKey;
-    if (TopPascalCodeFoldBlockType = cfbtIfThen) then
-      EndPascalCodeFoldBlock
-    else
+    //DebugLn('  ### Else');
+    // close all parent "else" and "do"
+    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
+      //DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
+      EndPascalCodeFoldBlockLastLine;
+    end;
+    if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
+      //DebugLn('    -> IfElse');
+      EndPascalCodeFoldBlock;
+      StartPascalCodeFoldBlock(cfbtIfElse);
+    end else
     if TopPascalCodeFoldBlockType = cfbtCase then begin
+      //DebugLn('    -> CaseElse');
       FTokenIsCaseLabel := True;
       StartPascalCodeFoldBlock(cfbtCaseElse);
-    end;
+    end
+    else begin
+      //DebugLn('    -> Other: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
+    end
   end
   else if KeyComp('Var') then begin
     if (PasCodeFoldRange.BracketNestLevel = 0) and
@@ -1496,7 +1516,7 @@
 begin
   if KeyComp('Except') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do // no semicolon before except
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do // no semicolon before except
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1522,7 +1542,7 @@
 begin
   if KeyComp('Until') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before until
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before until
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtRepeat);
     if TopPascalCodeFoldBlockType = cfbtRepeat then EndPascalCodeFoldBlock;
@@ -1534,7 +1554,7 @@
 begin
   if KeyComp('Finally') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do  // no semicolon before finally
+    while (TopPascalCodeFoldBlockType in [cfbtIfThen,cfbtIfElse]) do  // no semicolon before finally
       EndPascalCodeFoldBlock(True);
     SmartCloseBeginEndBlocks(cfbtTry);
     if TopPascalCodeFoldBlockType = cfbtTry then
@@ -1987,8 +2007,11 @@
 begin
   if KeyComp('Otherwise') then begin
     Result := tkKey;
-    while (TopPascalCodeFoldBlockType = cfbtIfThen) do
-      EndPascalCodeFoldBlock(True);
+    //DebugLn('  ### Otherwise');
+    while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfThen,cfbtIfElse]) do begin
+      //DebugLn('    Ending: %s', [FoldTypeToStr(TopPascalCodeFoldBlockType)]);
+      EndPascalCodeFoldBlockLastLine;
+    end;
     if TopPascalCodeFoldBlockType = cfbtCase then begin
       StartPascalCodeFoldBlock(cfbtCaseElse);
       FTokenIsCaseLabel := True;
@@ -2978,7 +3001,7 @@
     EndPascalCodeFoldBlock(True);
 
   fStringLen:=0;
-  while (tfb in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
+  while (tfb in [cfbtIfThen,cfbtIfElse,cfbtForDo,cfbtWhileDo,cfbtWithDo]) do begin
     EndPascalCodeFoldBlock(True);
     tfb := TopPascalCodeFoldBlockType;
   end;
@@ -3633,9 +3656,16 @@
   aActions := aActions + [sfaMultiLine];
 
   if (not FinishingABlock) and  (ABlockType <> nil) then begin
-    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo]) then
-      Include( aActions, sfaOutlineKeepLevel);
+    if (PasBlockType in [cfbtIfThen,cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) then
+    //Include( aActions, sfaOutlineKeepLevelOnSameLine);
+    Include( aActions, sfaOutlineKeepLevel);
 
+    //if (PasBlockType in [cfbtIfElse]) then
+    //  Include( aActions, sfaOutlineMergeLevelOnWrongCol);
+
+    if (PasBlockType in [cfbtClassSection]) then
+      Include( aActions, sfaOutlineMergeParent);
+
     if (PasBlockType in [cfbtProcedure]) then
       aActions := aActions + [sfaOutlineKeepLevel,sfaOutlineNoColor];
 
@@ -4101,7 +4131,7 @@
   case TPascalCodeFoldBlockType(Index) of
     cfbtRegion, cfbtNestedComment, cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment:
       m := [fmFold, fmHide] + m;
-    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo:
+    cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse:
       m := m;
     cfbtFirstPrivate..high(TPascalCodeFoldBlockType):
       m := [];
@@ -4122,7 +4152,7 @@
 
   m := Result.SupportedModes;
 
-  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo]) then
+  if (TPascalCodeFoldBlockType(Index) in [cfbtIfThen, cfbtForDo, cfbtWhileDo, cfbtWithDo, cfbtIfElse]) then
     m := [];
   if TPascalCodeFoldBlockType(Index) in [cfbtSlashComment] then
     Result.Modes := [fmFold, fmHide] + m

Pascal Riekenberg

2017-01-30 14:36

reporter   ~0097820

Last edited: 2017-01-30 14:36

View 2 revisions

The probelm is that case-else and otherwise are closing ifelse or ifthen
while not beeing a close-keyword for ifelse and ifthen like end is for begin or until is for repeat but TSynEditMarkupFoldColors colors it with the color of the
actual outline which it ends.
A quick solution is to use EndPascalCodeFoldBlockLastLine instead of EndPascalCodeFoldBlock: So the closing does not happen at the position of otherwise and case-else.
If this is okay to you use the patch v4. Otherwise i have to find out a way to get the information in TSynEditMarkupFoldColors.

Martin Friebe

2017-01-31 02:05

manager   ~0097829

last-line sounds correct.

I still need to review.

Pascal Riekenberg

2017-01-31 05:39

reporter   ~0097831

Okay, fine.

Martin Friebe

2017-01-31 17:12

manager   ~0097842

Notes:

I removed cfbtElse from PascalWordTripletRanges and cfbtEssential
The triplet is covered by cfbtifthen (the else is part of this as closing tag)
Essential is only for elements that are needed even if they do not markup or fold.

Handling "end" should probably do LastLine for cfbtElse (and ifthen/fordo/...)

Pascal Riekenberg

2017-02-01 06:19

reporter   ~0097855

Added patch to only use EndPascalCodeFoldBlockLastLine for the block before cfbtCaseElse

Pascal Riekenberg

2017-02-01 06:20

reporter  

synhighlighterpas.pp_v5.patch (732 bytes)
Index: synhighlighterpas.pp
===================================================================
--- synhighlighterpas.pp	(revision 54045)
+++ synhighlighterpas.pp	(working copy)
@@ -1183,7 +1183,10 @@
     // close all parent "else" and "do" // there can only be one else
     while (TopPascalCodeFoldBlockType in [cfbtForDo,cfbtWhileDo,cfbtWithDo,cfbtIfElse]) do begin
       //DebugLn('    Ending: %s', [dbgs(TopPascalCodeFoldBlockType)]);
-      EndPascalCodeFoldBlockLastLine;
+      if TopPascalCodeFoldBlockType(1) = cfbtCase then
+        EndPascalCodeFoldBlockLastLine
+      else
+        EndPascalCodeFoldBlock;
     end;
     if (TopPascalCodeFoldBlockType in [cfbtIfThen]) then begin
       EndPascalCodeFoldBlock;

Pascal Riekenberg

2017-02-01 08:24

reporter   ~0097856

Forget about this patch. I fixed it in the outline markup

Issue History

Date Modified Username Field Change
2016-07-29 09:47 Pascal Riekenberg New Issue
2016-07-29 09:47 Pascal Riekenberg File Added: else_for_pashighlighter_and_TSynFoldAction_for_coloring.patch
2016-07-29 14:54 Martin Friebe Assigned To => Martin Friebe
2016-07-29 14:54 Martin Friebe Status new => assigned
2016-08-01 13:27 Pascal Riekenberg File Added: synhighlighterpas.pp.patch
2016-08-01 13:29 Pascal Riekenberg Note Added: 0093940
2017-01-28 07:05 Pascal Riekenberg File Added: synhighlighterpas.pp_v2.patch
2017-01-28 07:07 Pascal Riekenberg Note Added: 0097759
2017-01-29 17:35 Martin Friebe Relationship added child of 0030421
2017-01-29 17:48 Martin Friebe LazTarget => -
2017-01-29 17:48 Martin Friebe Note Added: 0097787
2017-01-29 17:48 Martin Friebe Status assigned => feedback
2017-01-29 17:56 Martin Friebe Note Added: 0097788
2017-01-29 18:05 Martin Friebe Note Edited: 0097788 View Revisions
2017-01-30 07:31 Pascal Riekenberg Note Added: 0097802
2017-01-30 07:31 Pascal Riekenberg Status feedback => assigned
2017-01-30 08:10 Pascal Riekenberg Note Edited: 0097802 View Revisions
2017-01-30 08:45 Pascal Riekenberg Note Added: 0097805
2017-01-30 08:47 Pascal Riekenberg File Added: synhighlighterpas.pp_v3.patch
2017-01-30 08:51 Pascal Riekenberg Note Added: 0097806
2017-01-30 08:52 Pascal Riekenberg Note Edited: 0097806 View Revisions
2017-01-30 09:40 Pascal Riekenberg Note Edited: 0097805 View Revisions
2017-01-30 11:30 Pascal Riekenberg Note Edited: 0097802 View Revisions
2017-01-30 11:30 Pascal Riekenberg Note Edited: 0097802 View Revisions
2017-01-30 14:28 Pascal Riekenberg File Added: synhighlighterpas.pp_v4.patch
2017-01-30 14:36 Pascal Riekenberg Note Added: 0097820
2017-01-30 14:36 Pascal Riekenberg Note Edited: 0097820 View Revisions
2017-01-31 02:05 Martin Friebe Note Added: 0097829
2017-01-31 05:39 Pascal Riekenberg Note Added: 0097831
2017-01-31 17:12 Martin Friebe Fixed in Revision => 54042
2017-01-31 17:12 Martin Friebe LazTarget - => 1.8
2017-01-31 17:12 Martin Friebe Note Added: 0097842
2017-01-31 17:12 Martin Friebe Status assigned => resolved
2017-01-31 17:12 Martin Friebe Fixed in Version => 1.8
2017-01-31 17:12 Martin Friebe Resolution open => fixed
2017-01-31 17:12 Martin Friebe Target Version => 1.8
2017-02-01 06:19 Pascal Riekenberg Note Added: 0097855
2017-02-01 06:20 Pascal Riekenberg File Added: synhighlighterpas.pp_v5.patch
2017-02-01 06:20 Pascal Riekenberg Status resolved => assigned
2017-02-01 06:20 Pascal Riekenberg Resolution fixed => reopened
2017-02-01 08:24 Pascal Riekenberg Note Added: 0097856
2017-02-01 11:15 Martin Friebe Status assigned => resolved
2017-02-01 11:15 Martin Friebe Resolution reopened => fixed
2017-02-01 15:12 Pascal Riekenberg Status resolved => closed