From 5bbc3f9c75eb2a9385e571f06c873ab1abc03280 Mon Sep 17 00:00:00 2001 From: ondrej Date: Fri, 5 Feb 2021 11:40:36 +0000 Subject: [PATCH] SynEdit: move TSynBeautifierPascal to a new unit SynBeautifierPascal to remove circular dependency on SynEdit git-svn-id: trunk@64471 - --- .gitattributes | 1 + components/synedit/allsynedit.pas | 2 +- components/synedit/synbeautifier.pas | 1070 +------------------ components/synedit/synbeautifierpascal.pas | 1083 ++++++++++++++++++++ components/synedit/synedit.lpk | 6 +- 5 files changed, 1092 insertions(+), 1070 deletions(-) create mode 100644 components/synedit/synbeautifierpascal.pas diff --git a/.gitattributes b/.gitattributes index 049636b6a5..b1fac35e0c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4887,6 +4887,7 @@ components/synedit/lazsynedittext.pas svneol=native#text/pascal components/synedit/lazsynimm.pas svneol=native#text/pascal components/synedit/lazsyntextarea.pp svneol=native#text/pascal components/synedit/synbeautifier.pas svneol=native#text/plain +components/synedit/synbeautifierpascal.pas svneol=native#text/pascal components/synedit/syncompletion.pas svneol=native#text/pascal components/synedit/synedit.inc svneol=native#text/pascal components/synedit/synedit.lpk svneol=native#text/plain diff --git a/components/synedit/allsynedit.pas b/components/synedit/allsynedit.pas index a66ded41fe..80c818d461 100644 --- a/components/synedit/allsynedit.pas +++ b/components/synedit/allsynedit.pas @@ -32,7 +32,7 @@ uses SynHighlighterIni, SynEditMarkupSpecialChar, SynEditTextDoubleWidthChars, SynEditTextSystemCharWidth, SynEditMarkupIfDef, SynPluginMultiCaret, synhighlighterpike, SynEditMarkupFoldColoring, SynEditViewedLineMap, - SynEditWrappedView, LazarusPackageIntf; + SynEditWrappedView, LazarusPackageIntf, SynBeautifierPascal; implementation diff --git a/components/synedit/synbeautifier.pas b/components/synedit/synbeautifier.pas index 72e1c88c34..ab245c0ad3 100644 --- a/components/synedit/synbeautifier.pas +++ b/components/synedit/synbeautifier.pas @@ -40,9 +40,9 @@ unit SynBeautifier; interface uses - Classes, SysUtils, RegExpr, LCLProc, + Classes, SysUtils, LCLProc, SynEditMiscClasses, SynEditMiscProcs, LazSynEditText, SynEditPointClasses, - SynEditKeyCmds, SynHighlighterPas, SynEditHighlighterFoldBase; + SynEditKeyCmds; type @@ -254,212 +254,6 @@ type TSynCommentType = (sctAnsi, sctBor, sctSlash); // end mode - { TSynBeautifierPascal } - - TSynBeautifierPascal = class(TSynBeautifier) - private - FIndentMode: Array [TSynCommentType] of TSynCommentIndentFlags; - FIndentFirstLineExtra: Array [TSynCommentType] of String; - FIndentFirstLineMax: Array [TSynCommentType] of Integer; - - FCommentMode: Array [TSynCommentType] of TSynCommentContineMode; - FMatchMode: Array [TSynCommentType] of TSynCommentMatchMode; - FMatchLine: Array [TSynCommentType] of TSynCommentMatchLine; - FMatch: Array [TSynCommentType] of String; - FPrefix: Array [TSynCommentType] of String; - FCommentIndent: Array [TSynCommentType] of TSynBeautifierIndentType; - - FEolMatch: Array [TSynCommentType] of String; - FEolMode: Array [TSynCommentType] of TSynCommentContineMode; - FEolPostfix: Array [TSynCommentType] of String; - FEolSkipLongerLine: Array [TSynCommentType] of Boolean; - - FExtendSlashCommentMode: TSynCommentExtendMode; - - private - FPasHighlighter: TSynPasSyn; - - FCaretAtEOL: Boolean; - FStringBreakAppend: String; - FStringBreakEnabled: Boolean; - FStringBreakPrefix: String; - FWorkLine: Integer; // 1 based - FWorkFoldType: TSynCommentType; - FGetLineAfterComment: Boolean; - FRegExprEngine: TRegExpr; - - FCacheFoldEndLvlIdx, FCacheFoldEndLvl: Integer; - FCacheCommentLvlIdx, FCacheCommentLvl: Integer; - FCacheFoldTypeForIdx: Integer; - FCacheFoldType: TPascalCodeFoldBlockType; - FCacheFirstLineForIdx, FCacheFirstLine: Integer; - FCacheSlashColumnForIdx, FCacheSlashColumn: Integer; - FCacheCommentStartColForIdx, FCacheCommentStartCol: Integer; - FCacheLastHlTokenForIdx, FCacheLastHlTokenCol: Integer; - FCacheLastHlTokenKind: TtkTokenKind; - - FCacheWorkFoldEndLvl: Integer; - FCacheWorkCommentLvl: Integer; - FCacheWorkFoldType: TPascalCodeFoldBlockType; - FCacheWorkFirstLine: Integer; - FCacheWorkSlashCol: Integer; - FCacheWorkCommentStartCol: Integer; - - protected - function IsPasHighlighter: Boolean; - procedure InitCache; - procedure InitPasHighlighter; - // Generic Helpers - function GetFoldEndLevelForIdx(AIndex: Integer): Integer; - function GetFoldCommentLevelForIdx(AIndex: Integer): Integer; - function GetFoldTypeAtEndOfLineForIdx(AIndex: Integer): TPascalCodeFoldBlockType; - function GetFirstCommentLineForIdx(AIndex: Integer): Integer; // Result is 1 based - function GetSlashStartColumnForIdx(AIndex: Integer): Integer; - function GetLastHlTokenForIdx(AIndex: Integer; out APos: Integer): TtkTokenKind; - function GetCommentStartColForIdx(AIndex: Integer): Integer; // Returns Column (logic) for GetFirstCommentLineForIdx(AIndex) - // Values based on FWorkLine - function GetFoldEndLevel: Integer; - function GetFoldCommentLevel: Integer; - function GetFoldTypeAtEndOfLine: TPascalCodeFoldBlockType; - function GetFirstCommentLine: Integer; // Result is 1 based - function GetSlashStartColumn: Integer; // Acts on FWorkLine-1 - function GetCommentStartCol: Integer; // Acts on GetFirstCommentLineForIdx(FWorkLine) / Logical Resulc - - function GetMatchStartColForIdx(AIndex: Integer): Integer; // Res=1-based - function GetMatchStartPos(AIndex: Integer = -1; AForceFirst: Boolean = False): TPoint; // Res=1-based / AIndex-1 is only used for sclMatchPrev - - protected - function GetLine(AnIndex: Integer): String; override; - - procedure DoBeforeCommand(const ACaret: TSynEditCaret; - var Command: TSynEditorCommand); override; - procedure DoAfterCommand(const ACaret: TSynEditCaret; - var Command: TSynEditorCommand; - StartLinePos, EndLinePos: Integer); override; - procedure DoNewLineInString(AStringStartY, AStringStartX: Integer; - const ACaret: TSynEditCaret; - var Command: TSynEditorCommand; - StartLinePos, EndLinePos: Integer); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Assign(Src: TPersistent); override; - // Retruns a 0-based position (even 0-based physical) - published - // *** coments with (* *) - - (* AnsiIndentFirstLineMax: - * For comments that use any sciAlignOpen... - if AnsiIndentFirstLineMax is is set (none zero): - The indent will be limited to this value - - AnsiIndentFirstLineExtra: - For comments that do NOT start at the BOL, an extra indent is added - on the 2nd line (except if sciAlignOpen is used (in Flags)) - *) - property AnsiIndentMode: TSynCommentIndentFlags read FIndentMode[sctAnsi] - write FIndentMode[sctAnsi]; - property AnsiIndentFirstLineMax: Integer read FIndentFirstLineMax[sctAnsi] - write FIndentFirstLineMax[sctAnsi]; - property AnsiIndentFirstLineExtra: String read FIndentFirstLineExtra[sctAnsi] - write FIndentFirstLineExtra[sctAnsi]; - - (* match should start with ^, and leading spaces should not be in () "^\s?(\*\*?\*?)" - prefix can refer to $1 and should have spaces to indent after the match "$1 " - *) - property AnsiCommentMode: TSynCommentContineMode read FCommentMode[sctAnsi] - write FCommentMode[sctAnsi]; - property AnsiMatch: String read FMatch[sctAnsi] - write FMatch[sctAnsi]; - property AnsiPrefix : String read FPrefix[sctAnsi] - write FPrefix[sctAnsi]; - property AnsiMatchMode: TSynCommentMatchMode read FMatchMode[sctAnsi] - write FMatchMode[sctAnsi]; - property AnsiMatchLine: TSynCommentMatchLine read FMatchLine[sctAnsi] - write FMatchLine[sctAnsi]; - property AnsiCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctAnsi] - write FCommentIndent[sctAnsi]; - - // Add postfix at EOL - property AnsiEolMode: TSynCommentContineMode read FEolMode[sctAnsi] - write FEolMode[sctAnsi]; - property AnsiEolPostfix: String read FEolPostfix[sctAnsi] - write FEolPostfix[sctAnsi]; - property AnsiEolMatch: String read FEolMatch[sctAnsi] - write FEolMatch[sctAnsi]; - property AnsiEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctAnsi] - write FEolSkipLongerLine[sctAnsi]; - - // *** coments with { } - - property BorIndentMode: TSynCommentIndentFlags read FIndentMode[sctBor] - write FIndentMode[sctBor]; - property BorIndentFirstLineMax: Integer read FIndentFirstLineMax[sctBor] - write FIndentFirstLineMax[sctBor]; - property BorIndentFirstLineExtra: String read FIndentFirstLineExtra[sctBor] - write FIndentFirstLineExtra[sctBor]; - - property BorCommentMode: TSynCommentContineMode read FCommentMode[sctBor] - write FCommentMode[sctBor]; - property BorMatch: String read FMatch[sctBor] - write FMatch[sctBor]; - property BorPrefix : String read FPrefix[sctBor] - write FPrefix[sctBor]; - property BorMatchMode: TSynCommentMatchMode read FMatchMode[sctBor] - write FMatchMode[sctBor]; - property BorMatchLine: TSynCommentMatchLine read FMatchLine[sctBor] - write FMatchLine[sctBor]; - property BorCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctBor] - write FCommentIndent[sctBor]; - - property BorEolMode: TSynCommentContineMode read FEolMode[sctBor] - write FEolMode[sctBor]; - property BorEolPostfix : String read FEolPostfix[sctBor] - write FEolPostfix[sctBor]; - property BorEolMatch: String read FEolMatch[sctBor] - write FEolMatch[sctBor]; - property BorEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctBor] - write FEolSkipLongerLine[sctBor]; - - // *** coments with // - // Continue only, if Extended - - property ExtendSlashCommentMode: TSynCommentExtendMode read FExtendSlashCommentMode - write FExtendSlashCommentMode; - - property SlashIndentMode: TSynCommentIndentFlags read FIndentMode[sctSlash] - write FIndentMode[sctSlash]; - property SlashIndentFirstLineMax: Integer read FIndentFirstLineMax[sctSlash] - write FIndentFirstLineMax[sctSlash]; - property SlashIndentFirstLineExtra: String read FIndentFirstLineExtra[sctSlash] - write FIndentFirstLineExtra[sctSlash]; - - property SlashCommentMode: TSynCommentContineMode read FCommentMode[sctSlash] - write FCommentMode[sctSlash]; - property SlashMatch: String read FMatch[sctSlash] - write FMatch[sctSlash]; - property SlashPrefix : String read FPrefix[sctSlash] - write FPrefix[sctSlash]; - property SlashMatchMode: TSynCommentMatchMode read FMatchMode[sctSlash] - write FMatchMode[sctSlash]; - property SlashMatchLine: TSynCommentMatchLine read FMatchLine[sctSlash] - write FMatchLine[sctSlash]; - property SlashCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctSlash] - write FCommentIndent[sctSlash]; - - property SlashEolMode: TSynCommentContineMode read FEolMode[sctSlash] - write FEolMode[sctSlash]; - property SlashEolPostfix : String read FEolPostfix[sctSlash] - write FEolPostfix[sctSlash]; - property SlashEolMatch: String read FEolMatch[sctSlash] - write FEolMatch[sctSlash]; - property SlashEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctSlash] - write FEolSkipLongerLine[sctSlash]; - // String - property StringBreakEnabled: Boolean read FStringBreakEnabled write FStringBreakEnabled; - property StringBreakAppend: String read FStringBreakAppend write FStringBreakAppend; - property StringBreakPrefix: String read FStringBreakPrefix write FStringBreakPrefix; - end; function dbgs(ACommentType: TSynCommentType): String; overload; function dbgs(AContinueMode: TSynCommentContineMode): String; overload; @@ -517,866 +311,6 @@ begin end; -{ TSynBeautifierPascal } - -function TSynBeautifierPascal.IsPasHighlighter: Boolean; -begin - Result := (TSynEdit(FCurrentEditor).Highlighter <> nil) and - (TSynEdit(FCurrentEditor).Highlighter is TSynPasSyn); -end; - -procedure TSynBeautifierPascal.InitCache; -begin - FCacheFoldEndLvlIdx := -1; - FCacheCommentLvlIdx := -1; - FCacheFoldTypeForIdx := -1; - FCacheFirstLineForIdx := -1; - FCacheSlashColumnForIdx := -1; - FCacheCommentStartColForIdx := -1; - - FCacheWorkFoldEndLvl := -2; - FCacheWorkCommentLvl := -2; - FCacheWorkFoldType := cfbtIfThen; // dummy for not yet cached - FCacheWorkFirstLine := -2; - FCacheWorkSlashCol := -2; - FCacheWorkCommentStartCol := -2; - -end; - -procedure TSynBeautifierPascal.InitPasHighlighter; -begin - FPasHighlighter := TSynPasSyn(TSynEdit(FCurrentEditor).Highlighter); - FPasHighlighter.CurrentLines := FCurrentLines; - FPasHighlighter.ScanRanges; -end; - -function TSynBeautifierPascal.GetFoldEndLevelForIdx(AIndex: Integer): Integer; -begin - Result := FCacheFoldEndLvl; - if AIndex = FCacheFoldEndLvlIdx then - exit; - FCacheFoldEndLvlIdx := AIndex; - FCacheFoldEndLvl := FPasHighlighter.FoldBlockEndLevel(AIndex, FOLDGROUP_PASCAL, [sfbIncludeDisabled]); - Result := FCacheFoldEndLvl; -end; - -function TSynBeautifierPascal.GetFoldCommentLevelForIdx(AIndex: Integer): Integer; -var - tmp: Pointer; - Block: TPascalCodeFoldBlockType; -begin - Result := FCacheCommentLvl; - if AIndex = FCacheCommentLvlIdx then - exit; - FCacheCommentLvlIdx := AIndex; - - FCacheCommentLvl := GetFoldEndLevelForIdx(AIndex) - 1; - while (FCacheCommentLvl > 0) do begin - FPasHighlighter.FoldBlockNestedTypes(AIndex , FCacheCommentLvl - 1, - tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]); - Block:=TPascalCodeFoldBlockType(PtrUInt(tmp)); - if not (Block in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) then - break; - dec(FCacheCommentLvl); - end; - inc(FCacheCommentLvl); - Result := FCacheCommentLvl; -end; - -function TSynBeautifierPascal.GetFoldTypeAtEndOfLineForIdx(AIndex: Integer): TPascalCodeFoldBlockType; -var - EndLevel: Integer; - tmp: Pointer; -begin - // TODO cfbtNestedComment - Result := FCacheFoldType; - if AIndex = FCacheFoldTypeForIdx then - exit; - - FCacheFoldTypeForIdx := AIndex; - EndLevel := GetFoldEndLevelForIdx(AIndex); - if (EndLevel > 0) then - begin - if FPasHighlighter.FoldBlockNestedTypes(AIndex, EndLevel - 1, - tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) - then - FCacheFoldType:=TPascalCodeFoldBlockType(PtrUInt(tmp)) - else - FCacheFoldType := cfbtNone; - end; - - while (FCacheFoldType = cfbtNestedComment) and (EndLevel > 1) do begin - dec(EndLevel); - if FPasHighlighter.FoldBlockNestedTypes(AIndex, EndLevel - 1, - tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) - then - FCacheFoldType:=TPascalCodeFoldBlockType(PtrUInt(tmp)) - else - FCacheFoldType := cfbtNone; - end; - - Result := FCacheFoldType; -end; - -function TSynBeautifierPascal.GetFirstCommentLineForIdx(AIndex: Integer): Integer; -var - FoldType: TPascalCodeFoldBlockType; - ANewIndex, EndLvl, CommentLvl: Integer; -begin - Result := FCacheFirstLine; - if AIndex = FCacheFirstLineForIdx then - exit; - - ANewIndex := AIndex; - FoldType := GetFoldTypeAtEndOfLineForIdx(ANewIndex); - EndLvl := GetFoldEndLevelForIdx(ANewIndex); - - //if (EndLvl = 0) or not(FoldType in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and - // (AIndex > 0) and (GetSlashStartColumnForIdx(AIndex - 1) > 0) - //then begin - // dec(ANewIndex); - // FoldType := GetFoldTypeAtEndOfLineForIdx(ANewIndex); - // EndLvl := GetFoldEndLevelForIdx(ANewIndex); - //end; - - if (EndLvl = 0) or not(FoldType in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) - then begin - Result := ToPos(AIndex) - 1; // 1 based - the line above ANewIndex - // maybe the line above has a trailing comment - //if (AIndex <> ANewIndex) and (ANewIndex > 0) and (GetSlashStartColumnForIdx(ANewIndex-1) > 0) then - // Result := ToPos(ANewIndex) - 1; - exit; - end; - - FCacheFirstLineForIdx := AIndex; - FCacheFirstLine := ToPos(ANewIndex) - 1; - CommentLvl := GetFoldCommentLevelForIdx(ANewIndex); - - while (FCacheFirstLine > 0) do begin - if CommentLvl > FPasHighlighter.FoldBlockMinLevel(FCacheFirstLine-1, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) then - break; - dec(FCacheFirstLine); - end; - - if FoldType = cfbtSlashComment then begin - // maybe the line above has a trailing comment - if GetSlashStartColumnForIdx(ToIdx(FCacheFirstLine)) > 0 then - dec(FCacheFirstLine); - end; - - Result := FCacheFirstLine; -//debugln(['FIRST LINE ', FCacheFirstLine]); -end; - -function TSynBeautifierPascal.GetSlashStartColumnForIdx(AIndex: Integer): Integer; -var - Tk: TtkTokenKind; -begin - Result := FCacheSlashColumn; - if AIndex = FCacheSlashColumnForIdx then - exit; - - FCacheSlashColumnForIdx := AIndex; - Tk := GetLastHlTokenForIdx(AIndex, FCacheSlashColumn); - if Tk <> SynHighlighterPas.tkComment then - FCacheSlashColumn := -1; - Result := FCacheSlashColumn; -end; - -function TSynBeautifierPascal.GetLastHlTokenForIdx(AIndex: Integer; out - APos: Integer): TtkTokenKind; -begin - Result := FCacheLastHlTokenKind; - APos := FCacheLastHlTokenCol; - if AIndex = FCacheLastHlTokenForIdx then - exit; - - FCacheSlashColumnForIdx := AIndex; - FCacheLastHlTokenKind := SynHighlighterPas.tkUnknown; - FCacheLastHlTokenCol := -1; - if (FCurrentLines[AIndex] <> '') then begin - FPasHighlighter.StartAtLineIndex(AIndex); - while not FPasHighlighter.GetEol do begin - FCacheLastHlTokenKind := TtkTokenKind(FPasHighlighter.GetTokenKind); - FCacheLastHlTokenCol := FPasHighlighter.GetTokenPos + 1; - FPasHighlighter.Next; - end; - end; - Result := FCacheLastHlTokenKind; - APos := FCacheLastHlTokenCol; -end; - -function TSynBeautifierPascal.GetCommentStartColForIdx(AIndex: Integer): Integer; -var - nl: TLazSynFoldNodeInfoList; - i: Integer; - FoldCommentLvl: Integer; -begin - Result := FCacheCommentStartCol; - if AIndex = FCacheCommentStartColForIdx then - exit; - FCacheCommentStartColForIdx := AIndex; - - if (GetFoldEndLevelForIdx(AIndex) = 0) or - not(GetFoldTypeAtEndOfLineForIdx(AIndex) in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) - then begin - // must be SlashComment - FCacheCommentStartCol := GetSlashStartColumnForIdx(AIndex - 1); - //FCacheCommentStartCol := GetSlashStartColumnForIdx(AIndex); - //if FCacheCommentStartCol > 0 then begin - // i := GetSlashStartColumnForIdx(AIndex - 1); - // if i > 0 then - // FCacheCommentStartCol := i; - //end; - Result := FCacheCommentStartCol; -//debugln(['FIRST COL prev-// ', FCacheCommentStartCol]); - exit; - end; - - FCacheCommentStartCol := -1; - FoldCommentLvl := GetFoldCommentLevelForIdx(AIndex); - nl := FPasHighlighter.FoldNodeInfo[GetFirstCommentLineForIdx(AIndex) - 1]; - nl.AddReference; - nl.ClearFilter; - nl.ActionFilter := [sfaOpen]; - nl.GroupFilter := FOLDGROUP_PASCAL; - i := nl.Count - 1; - while i >= 0 do begin - if (not (sfaInvalid in nl[i].FoldAction)) and - (nl[i].NestLvlEnd = FoldCommentLvl) - then begin - FCacheCommentStartCol := nl[i].LogXStart + 1; // Highlighter pos are 0 based - break; - end; - dec(i); - end; - nl.ReleaseReference; -//debugln(['FIRST COL ', FCacheCommentStartCol]); - - Result := FCacheCommentStartCol; -end; - -function TSynBeautifierPascal.GetFoldEndLevel: Integer; -begin - Result := FCacheWorkFoldEndLvl; - if FCacheWorkFoldEndLvl > -2 then - exit; - FCacheWorkFoldEndLvl := GetFoldEndLevelForIdx(FWorkLine-1); - Result := FCacheWorkFoldEndLvl; -end; - -function TSynBeautifierPascal.GetFoldCommentLevel: Integer; -begin - Result := FCacheWorkCommentLvl; - if FCacheWorkCommentLvl > -2 then - exit; - FCacheWorkCommentLvl := GetFoldCommentLevelForIdx(FWorkLine-1); - Result := FCacheWorkCommentLvl; -end; - -function TSynBeautifierPascal.GetFoldTypeAtEndOfLine: TPascalCodeFoldBlockType; -begin - Result := FCacheWorkFoldType; - if FCacheWorkFoldType <> cfbtIfThen then - exit; - FCacheWorkFoldType := GetFoldTypeAtEndOfLineForIdx(FWorkLine-1); - Result := FCacheWorkFoldType; -end; - -function TSynBeautifierPascal.GetFirstCommentLine: Integer; -begin - Result := FCacheWorkFirstLine; - if FCacheWorkFirstLine > -2 then - exit; - FCacheWorkFirstLine := GetFirstCommentLineForIdx(FWorkLine-1); - Result := FCacheWorkFirstLine; -end; - -function TSynBeautifierPascal.GetSlashStartColumn: Integer; -begin - Result := FCacheWorkSlashCol; - if FCacheWorkSlashCol > -2 then - exit; - FCacheWorkSlashCol := GetSlashStartColumnForIdx(FWorkLine-2); - Result := FCacheWorkSlashCol; -end; - -function TSynBeautifierPascal.GetCommentStartCol: Integer; -begin - Result := FCacheWorkCommentStartCol; - if FCacheWorkCommentStartCol > -2 then - exit; - FCacheWorkCommentStartCol := GetCommentStartColForIdx(FWorkLine-1); - Result := FCacheWorkCommentStartCol; -end; - -function TSynBeautifierPascal.GetMatchStartColForIdx(AIndex: Integer): Integer; -begin - if ToPos(AIndex) = GetFirstCommentLine then begin - // Match on FirstLine - case FMatchMode[FWorkFoldType] of - scmMatchAfterOpening: begin - if FWorkFoldType = sctBor - then Result := GetCommentStartCol + 1 - else Result := GetCommentStartCol + 2; - end; - scmMatchOpening: Result := GetCommentStartCol; - scmMatchWholeLine: Result := 1; - scmMatchAtAsterisk: Result := GetCommentStartCol + 1; - end; - end - else begin - // Match on prev, not first - case FMatchMode[FWorkFoldType] of - scmMatchAfterOpening, scmMatchOpening, scmMatchAtAsterisk: - Result := 1 + GetIndentForLine(nil, FCurrentLines[AIndex], False); - scmMatchWholeLine: - Result := 1; - end; - end; -end; - -function TSynBeautifierPascal.GetMatchStartPos(AIndex: Integer; AForceFirst: Boolean): TPoint; -begin - if AIndex < 0 then - AIndex := ToIdx(FWorkLine); - - if AForceFirst then - Result.Y := GetFirstCommentLine - else - case FMatchLine[FWorkFoldType] of - sclMatchFirst: Result.Y := GetFirstCommentLine; - sclMatchPrev: Result.Y := ToPos(AIndex)-1; // FWorkLine - 1 - end; - - Result.X := GetMatchStartColForIdx(ToIdx(Result.Y)); -end; - - -function TSynBeautifierPascal.GetLine(AnIndex: Integer): String; -var - ReplacedPrefix: String; - Indent, PreFixPos: Integer; - r: Boolean; - p: TPoint; -begin - if not FGetLineAfterComment then begin - Result := inherited GetLine(AnIndex); - exit; - end; - - // Need to cut of existing Prefix to find indent after prefix - - if AnIndex < GetFirstCommentLine-1 then begin - Result := ''; -//debugln(['GETLINE FROM (< First) ', AnIndex,' ''', FCurrentLines[AnIndex], ''' to empty']); - end; - - // 1) Run the match for this line (match prev, or first) - // and see if we can find the replaced prefix in this line - if AnIndex > GetFirstCommentLine-1 then begin - p := GetMatchStartPos(AnIndex); - FRegExprEngine.InputString:= copy(FCurrentLines[ToIdx(p.y)], p.x, MaxInt); - FRegExprEngine.Expression := FMatch[FWorkFoldType]; - if FRegExprEngine.ExecPos(1) then begin - ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[FWorkFoldType]); - while (ReplacedPrefix <> '') and (ReplacedPrefix[1] in [#9, ' ']) do - delete(ReplacedPrefix, 1, 1); - while (ReplacedPrefix <> '') and (ReplacedPrefix[length(ReplacedPrefix)] in [#9, ' ']) do - delete(ReplacedPrefix, length(ReplacedPrefix), 1); - if ReplacedPrefix <> '' then begin - Result := FCurrentLines[AnIndex]; - PreFixPos := pos(ReplacedPrefix, Result); - if (PreFixPos > 0) and (PreFixPos <= GetMatchStartColForIdx(AnIndex)) then begin - delete(Result, 1, PreFixPos - 1 + Length(ReplacedPrefix)); -//debugln(['GETLINE FROM (1) ', AnIndex,' ''', FCurrentLines[AnIndex], ''' to ''', Result, '''']); - exit; - end; - end; - end; - end - else - p := Point(0,0); - - // 2) See, if the current-1 line can be matched - r := False; - Result := FCurrentLines[AnIndex]; - Indent := GetMatchStartColForIdx(AnIndex); - FRegExprEngine.InputString:= copy(FCurrentLines[AnIndex], Indent, MaxInt); - FRegExprEngine.Expression := FMatch[FWorkFoldType]; - r := FRegExprEngine.ExecPos(1); - if (not r) and (Indent > 1) and - ((p.y <> GetFirstCommentLine) or (FMatchMode[FWorkFoldType] = scmMatchWholeLine)) - then begin - // try whole line -// TODO: only if not first, or if setting - FRegExprEngine.InputString := FCurrentLines[AnIndex]; - r := FRegExprEngine.ExecPos(1); - if r then - Indent := 1; - end; - if (r) then begin - Indent := Indent + FRegExprEngine.MatchPos[0] - 1 + FRegExprEngine.MatchLen[0]; - Result := FCurrentLines[AnIndex]; - if (Indent <= Length(Result)) then - while (Indent > 1) and (Result[Indent] in [#9, ' ']) do - dec(Indent); - inc(Indent); - if Indent > 0 then begin - Result := copy(Result, Indent, MaxInt); -//debugln(['GETLINE FROM (2) ', AnIndex,' ''', FCurrentLines[AnIndex], ''' to ''', Result, '''']); - exit; - end; - end; - - // 3) maybe try currest replace, if different from 1? - - // Nothing found - Result := ''; -//debugln(['GETLINE FROM (X) ', AnIndex,' ''', FCurrentLines[AnIndex], ''' to empty']); -end; - -procedure TSynBeautifierPascal.DoBeforeCommand(const ACaret: TSynEditCaret; - var Command: TSynEditorCommand); -begin - FCaretAtEOL := ACaret.BytePos > Length(FCurrentLines[ToIdx(ACaret.LinePos)]); - FGetLineAfterComment := False; - inherited DoBeforeCommand(ACaret, Command); -end; - -procedure TSynBeautifierPascal.DoAfterCommand(const ACaret: TSynEditCaret; - var Command: TSynEditorCommand; StartLinePos, EndLinePos: Integer); - -var - WorkLine, PrevLineShlasCol: Integer; - ReplacedPrefix: String; // Each run matches only one Type - MatchResultIntern, MatchedBOLIntern: Array [Boolean] of Boolean; // Each run matches only one Type - - function CheckMatch(AType: TSynCommentType; AFailOnNoPattern: Boolean = False; - AForceFirst: Boolean = False): Boolean; - var - p: TPoint; - begin - if (FMatch[AType] = '') and AFailOnNoPattern then begin - Result := False; - exit; - end; - - if MatchedBOLIntern[AForceFirst] then begin - Result := MatchResultIntern[AForceFirst]; - exit; - end; - - p := GetMatchStartPos(-1, AForceFirst); - - FRegExprEngine.InputString:= copy(FCurrentLines[ToIdx(p.y)], p.x, MaxInt); - if (FRegExprEngine.InputString='') then - exit(false); - FRegExprEngine.Expression := FMatch[AType]; - if not FRegExprEngine.ExecPos(1) then begin - ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[AType]); - MatchedBOLIntern[AForceFirst] := True; - MatchResultIntern[AForceFirst] := False; - Result := MatchResultIntern[AForceFirst]; - exit; - end; - - ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[AType]); - MatchedBOLIntern[AForceFirst] := True; - MatchResultIntern[AForceFirst] := True; - Result := MatchResultIntern[AForceFirst]; - - end; - - function IsFoldTypeEnabled(AType: TSynCommentType): Boolean; - begin - Result := ( ( (AType <> sctSlash) or - ( ((not FCaretAtEOL) and (FExtendSlashCommentMode <> sceNever)) or - ((FCaretAtEOL) and not(FExtendSlashCommentMode in [sceNever, sceSplitLine, sceMatchingSplitLine])) - ) - ) and - ( (FIndentMode[AType] <> []) or - (FCommentMode[AType] <> sccNoPrefix) or - (FEolMode[AType] <> sccNoPrefix) - )) - end; - -var - Indent, dummy: Integer; - s: String; - FoldTyp: TSynCommentType; - AnyEnabled: Boolean; - ExtendSlash, BeSmart, Matching: Boolean; - PreviousIsFirst, CommentStartsAtBOL, DidAlignOpen: Boolean; - - IndentTypeBackup: TSynBeautifierIndentType; - -begin - if (EndLinePos < 1) or - ((Command <> ecLineBreak) and (Command <> ecInsertLine)) or - (not IsPasHighlighter) - then begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - exit; - end; - - AnyEnabled := False; - for FoldTyp := low(TSynCommentType) to high(TSynCommentType) do - AnyEnabled := AnyEnabled or IsFoldTypeEnabled(FoldTyp); - if (not AnyEnabled) and (not FStringBreakEnabled) then begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - exit; - end; - - InitCache; - InitPasHighlighter; - FGetLineAfterComment := False; - MatchedBOLIntern[True] := False; - MatchedBOLIntern[False] := False; - PrevLineShlasCol := -1; - dummy := 0; - - if (Command = ecLineBreak) - then WorkLine := ACaret.LinePos - else WorkLine := ACaret.LinePos + 1; - FWorkLine := WorkLine; - - - // Find Foldtype - case GetFoldTypeAtEndOfLine of - cfbtAnsiComment: FoldTyp := sctAnsi; - cfbtBorCommand: FoldTyp := sctBor; - cfbtSlashComment: FoldTyp := sctSlash; - else - begin - if (FCurrentLines[ToIdx(WorkLine)-1] <> '') and - (FExtendSlashCommentMode <> sceNever) and - ( (not FCaretAtEOL) or not(FExtendSlashCommentMode in [sceSplitLine, sceMatchingSplitLine]) ) - then begin - PrevLineShlasCol := GetSlashStartColumn; - if PrevLineShlasCol > 0 then - FoldTyp := sctSlash; - end; - if PrevLineShlasCol < 0 then begin - if (FCurrentLines[ToIdx(WorkLine)-1] <> '') and - (GetLastHlTokenForIdx(ToIdx(WorkLine)-1, dummy) = SynHighlighterPas.tkString) - then - DoNewLineInString(WorkLine - 1, dummy, ACaret, Command, StartLinePos, EndLinePos) - else - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - exit; - end; - end; - end; - - if not IsFoldTypeEnabled(FoldTyp) then begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - exit; - end; - - FWorkFoldType := FoldTyp; - - // Check if we need extend - ExtendSlash := False; - if (FoldTyp = sctSlash) and (ACaret.OldLineBytePos.x > GetSlashStartColumn+2) then begin - // Check if extension is needed - case FExtendSlashCommentMode of - sceAlways: ExtendSlash := True; - sceSplitLine: ExtendSlash := not FCaretAtEOL; - sceMatching: ExtendSlash := CheckMatch(FoldTyp); - sceMatchingSplitLine: ExtendSlash := CheckMatch(FoldTyp) and (not FCaretAtEOL); - end; - - if not ExtendSlash then begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - exit; - end; - end; - - // Indent - Matching := CheckMatch(FoldTyp); - PreviousIsFirst := (GetFirstCommentLine = WorkLine -1); - DidAlignOpen := False; - CommentStartsAtBOL := True; - if PreviousIsFirst then - CommentStartsAtBOL := GetCommentStartCol = 1 + GetIndentForLine(nil, FCurrentLines[ToIdx(GetFirstCommentLine)], False); - - - // Aply indent before prefix - if Matching or (FCommentMode[FoldTyp] = sccPrefixAlways) or (sciApplyIndentForNoMatch in FIndentMode[FoldTyp]) - then begin - IndentTypeBackup := IndentType; - try - if IndentType = sbitPositionCaret then - IndentType := sbitSpace; - if IndentType = sbitConvertToTabOnly then - IndentType := sbitConvertToTabSpace; - - // Align with open - if ( (FIndentMode[FoldTyp] * [sciNone, sciAlignOpen] = [sciAlignOpen]) or - ( (sciAlignOpenOnce in FIndentMode[FoldTyp]) and PreviousIsFirst ) - ) and - ( (not (sciAlignOpenSkipBOL in FIndentMode[FoldTyp])) or (not CommentStartsAtBOL) ) - then begin - Indent := FCurrentLines.LogicalToPhysicalCol(FCurrentLines[ToIdx(GetFirstCommentLine)], - ToIdx(GetFirstCommentLine), - GetCommentStartCol-1); - if FIndentFirstLineMax[FoldTyp] > 0 - then Indent := Min(Indent, FIndentFirstLineMax[FoldTyp]); - s := GetCharMix(WorkLine, Indent, dummy); - FLogicalIndentLen := length(s); - FCurrentLines.EditInsert(1, WorkLine, s); - DidAlignOpen := True; - end - else - // Do not align with open, but check MaxIndent - if PreviousIsFirst and (FIndentFirstLineMax[FoldTyp] > 0) and - (FIndentMode[FoldTyp] * [sciNone] = []) then begin - Indent := GetIndentForLine(nil, FCurrentLines[ToIdx(WorkLine-1)], False); - Indent := Min(Indent, FIndentFirstLineMax[FoldTyp]); - s := GetCharMix(WorkLine, Indent, dummy); - FLogicalIndentLen := length(s); - FCurrentLines.EditInsert(1, WorkLine, s); - end - else - if (sciNone in FIndentMode[FoldTyp]) then begin - // No indent - end - else - begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - end; - finally - IndentType := IndentTypeBackup; - end; - - // AnsiIndentFirstLineExtra - if PreviousIsFirst and (not CommentStartsAtBOL) and (not DidAlignOpen) then begin - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, FIndentFirstLineExtra[FoldTyp]); - FLogicalIndentLen := FLogicalIndentLen + length(FIndentFirstLineExtra[FoldTyp]); - end; - - end - else - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - - Indent := 0; // Extra Indent - BeSmart := (PreviousIsFirst or (sciAlignOpen in FIndentMode[FoldTyp])) and - (Matching or ExtendSlash or (sciApplyIndentForNoMatch in FIndentMode[FoldTyp]) or - (FCommentMode[FoldTyp] = sccPrefixAlways) ); - - // sciAddTokenLen -- Spaces for (* or { - if BeSmart and - ( (sciAddTokenLen in FIndentMode[FoldTyp]) and - ( (not(sciMatchOnlyTokenLen in FIndentMode[FoldTyp])) or CheckMatch(FoldTyp, False, True) ) and - ( (not(sciAlignOnlyTokenLen in FIndentMode[FoldTyp])) or DidAlignOpen ) - ) - then begin - case FoldTyp of - sctAnsi: if FMatchMode[FoldTyp] = scmMatchAtAsterisk - then Indent := 1 - else Indent := 2; - sctBor: Indent := 1; - sctSlash: if ExtendSlash - then Indent := 0 // do the slashes - else Indent := 2; - end; - end; - - // sciAddPastTokenIndent -- Spaces from after (* or { (to go before prefix e.g " { * foo") - if BeSmart and - ( (sciAddPastTokenIndent in FIndentMode[FoldTyp]) and - ( (not(sciMatchOnlyPastTokenIndent in FIndentMode[FoldTyp])) or CheckMatch(FoldTyp, False, True) ) and - ( (not(sciAlignOnlyPastTokenIndent in FIndentMode[FoldTyp])) or DidAlignOpen ) - ) and - (GetCommentStartCol > 0) // foundStartCol - then begin - case FoldTyp of - // ignores scmMatchAtAsterisk - sctAnsi: s := copy(FCurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+2, MaxInt); - sctBor: s := copy(FCurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+1, MaxInt); - sctSlash: s := copy(FCurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+2, MaxInt); - end; - Indent := Indent + GetIndentForLine(nil, s, False); - end; - // Extend // - if ExtendSlash then begin - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, '//'); - FLogicalIndentLen := FLogicalIndentLen + 2; - end; - if (Indent > 0) then begin - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, StringOfChar(' ', Indent )); - FLogicalIndentLen := FLogicalIndentLen + Indent; - end; - - // Apply prefix - if (FCommentMode[FoldTyp] = sccPrefixAlways) or - ((FCommentMode[FoldTyp] = sccPrefixMatch) and Matching) - then begin - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, ReplacedPrefix); - FLogicalIndentLen := FLogicalIndentLen + length(ReplacedPrefix); - - // Post prefix indent - FGetLineAfterComment := True; - try - GetIndentInfo(WorkLine, s, Indent, GetFirstCommentLine); - if s <> '' then begin - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, s); - FLogicalIndentLen := FLogicalIndentLen + length(s); // logical (Indent is phisical) - end - else - FLogicalIndentLen := FLogicalIndentLen + Indent; // maybe position caret - finally - FGetLineAfterComment := False; - end; - end; - - - if (Command = ecLineBreak) then begin - ACaret.IncForcePastEOL; - ACaret.BytePos := 1 + FLogicalIndentLen; - ACaret.DecForcePastEOL; - end; - -end; - -procedure TSynBeautifierPascal.DoNewLineInString(AStringStartY, AStringStartX: Integer; - const ACaret: TSynEditCaret; var Command: TSynEditorCommand; StartLinePos, - EndLinePos: Integer); -var - s: String; - WorkLine: Integer; - f: Boolean; -begin - inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); - if not FStringBreakEnabled then - exit; - - if (Command = ecLineBreak) - then WorkLine := ACaret.LinePos - 1 - else WorkLine := ACaret.LinePos; - - s := FCurrentLines[ToIdx(WorkLine)]; - if (AStringStartX < 1) or (AStringStartX > Length(s)) or (s[AStringStartX] <> '''') then - exit; - f := False; - while AStringStartX <= length(s) do begin - if (s[AStringStartX] = '''') then f := not f; - inc(AStringStartX); - end; - if not f then exit; - - ACaret.IncForcePastEOL; - - FCurrentLines.EditInsert(1 + length(s), WorkLine, '''' + FStringBreakAppend); - //if Command = ecInsertLine then - // ACaret.BytePos := ACaret.BytePos + Length(FStringBreakAppend) + 1; - - FCurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine + 1, FStringBreakPrefix + ''''); - if (Command = ecLineBreak) then - ACaret.BytePos := ACaret.BytePos + Length(FStringBreakPrefix) + 1; - - ACaret.DecForcePastEOL; -end; - -constructor TSynBeautifierPascal.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FRegExprEngine := TRegExpr.Create; - FRegExprEngine.ModifierI := True; - - FIndentMode[sctAnsi] := [sciAddTokenLen, sciAddPastTokenIndent]; - FIndentFirstLineExtra[sctAnsi] := ''; - FIndentFirstLineMax[sctAnsi] := 0; - - FCommentMode[sctAnsi] := sccPrefixMatch; - FMatch[sctAnsi] := '^ ?(\*)'; - FMatchMode[sctAnsi] := scmMatchAfterOpening; - FMatchLine[sctAnsi] := sclMatchPrev; - FPrefix[sctAnsi] := '$1'; - - FEolMatch[sctAnsi] := ''; - FEolMode[sctAnsi] := sccNoPrefix; - FEolPostfix[sctAnsi] := ''; - FEolSkipLongerLine[sctAnsi] := False; - - - FIndentMode[sctBor] := [sciAddTokenLen, sciAddPastTokenIndent]; - FIndentFirstLineExtra[sctBor] := ''; - FIndentFirstLineMax[sctBor] := 0; - - FCommentMode[sctBor] := sccPrefixMatch; - FMatch[sctBor] := '^ ?(\*)'; - FMatchMode[sctBor] := scmMatchAfterOpening; - FMatchLine[sctBor] := sclMatchPrev; - FPrefix[sctBor] := '$1'; - - FEolMatch[sctBor] := ''; - FEolMode[sctBor] := sccNoPrefix; - FEolPostfix[sctBor] := ''; - FEolSkipLongerLine[sctBor] := False; - - - FExtendSlashCommentMode := sceNever; - - FIndentMode[sctSlash] := []; - FIndentFirstLineExtra[sctSlash] := ''; - FIndentFirstLineMax[sctSlash] := 0; - - FCommentMode[sctSlash] := sccPrefixMatch; - FMatch[sctSlash] := '^ ?(\*)'; - FMatchMode[sctSlash] := scmMatchAfterOpening; - FMatchLine[sctSlash] := sclMatchPrev; - FPrefix[sctSlash] := '$1'; - - FEolMatch[sctSlash] := ''; - FEolMode[sctSlash] := sccNoPrefix; - FEolPostfix[sctSlash] := ''; - FEolSkipLongerLine[sctSlash] := False; - - FStringBreakEnabled := False; - FStringBreakAppend := ' +'; - FStringBreakPrefix := ''; -end; - -destructor TSynBeautifierPascal.Destroy; -begin - inherited Destroy; - FreeAndNil(FRegExprEngine); -end; - -procedure TSynBeautifierPascal.Assign(Src: TPersistent); -var - i: TSynCommentType; -begin - inherited Assign(Src); - if not(Src is TSynBeautifierPascal) then exit; - - FExtendSlashCommentMode := TSynBeautifierPascal(Src).FExtendSlashCommentMode; - - for i := low(TSynCommentType) to high(TSynCommentType) do begin - FIndentMode[i] := TSynBeautifierPascal(Src).FIndentMode[i]; - FIndentFirstLineExtra[i] := TSynBeautifierPascal(Src).FIndentFirstLineExtra[i]; - FIndentFirstLineMax[i] := TSynBeautifierPascal(Src).FIndentFirstLineMax[i]; - - FCommentMode[i] := TSynBeautifierPascal(Src).FCommentMode[i]; - FMatch[i] := TSynBeautifierPascal(Src).FMatch[i]; - FMatchMode[i] := TSynBeautifierPascal(Src).FMatchMode[i]; - FMatchLine[i] := TSynBeautifierPascal(Src).FMatchLine[i]; - FPrefix[i] := TSynBeautifierPascal(Src).FPrefix[i]; - - FEolMatch[i] := TSynBeautifierPascal(Src).FEolMatch[i]; - FEolMode[i] := TSynBeautifierPascal(Src).FEolMode[i]; - FEolPostfix[i] := TSynBeautifierPascal(Src).FEolPostfix[i]; - FEolSkipLongerLine[i] := TSynBeautifierPascal(Src).FEolSkipLongerLine[i]; - end; - - FStringBreakAppend := TSynBeautifierPascal(Src).FStringBreakAppend; - FStringBreakEnabled := TSynBeautifierPascal(Src).FStringBreakEnabled; - FStringBreakPrefix := TSynBeautifierPascal(Src).FStringBreakPrefix; - -end; - { TSynCustomBeautifier } procedure TSynCustomBeautifier.Assign(Src: TPersistent); diff --git a/components/synedit/synbeautifierpascal.pas b/components/synedit/synbeautifierpascal.pas new file mode 100644 index 0000000000..c65ab0fa3d --- /dev/null +++ b/components/synedit/synbeautifierpascal.pas @@ -0,0 +1,1083 @@ +unit synbeautifierpascal; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, RegExpr, SynBeautifier, SynHighlighterPas, SynEditPointClasses, SynEditKeyCmds, SynEdit, + SynEditHighlighterFoldBase, SynEditMiscProcs; + +type + { TSynBeautifierPascal } + + TSynBeautifierPascal = class(TSynBeautifier) + private + FIndentMode: Array [TSynCommentType] of TSynCommentIndentFlags; + FIndentFirstLineExtra: Array [TSynCommentType] of String; + FIndentFirstLineMax: Array [TSynCommentType] of Integer; + + FCommentMode: Array [TSynCommentType] of TSynCommentContineMode; + FMatchMode: Array [TSynCommentType] of TSynCommentMatchMode; + FMatchLine: Array [TSynCommentType] of TSynCommentMatchLine; + FMatch: Array [TSynCommentType] of String; + FPrefix: Array [TSynCommentType] of String; + FCommentIndent: Array [TSynCommentType] of TSynBeautifierIndentType; + + FEolMatch: Array [TSynCommentType] of String; + FEolMode: Array [TSynCommentType] of TSynCommentContineMode; + FEolPostfix: Array [TSynCommentType] of String; + FEolSkipLongerLine: Array [TSynCommentType] of Boolean; + + FExtendSlashCommentMode: TSynCommentExtendMode; + + private + FPasHighlighter: TSynPasSyn; + + FCaretAtEOL: Boolean; + FStringBreakAppend: String; + FStringBreakEnabled: Boolean; + FStringBreakPrefix: String; + FWorkLine: Integer; // 1 based + FWorkFoldType: TSynCommentType; + FGetLineAfterComment: Boolean; + FRegExprEngine: TRegExpr; + + FCacheFoldEndLvlIdx, FCacheFoldEndLvl: Integer; + FCacheCommentLvlIdx, FCacheCommentLvl: Integer; + FCacheFoldTypeForIdx: Integer; + FCacheFoldType: TPascalCodeFoldBlockType; + FCacheFirstLineForIdx, FCacheFirstLine: Integer; + FCacheSlashColumnForIdx, FCacheSlashColumn: Integer; + FCacheCommentStartColForIdx, FCacheCommentStartCol: Integer; + FCacheLastHlTokenForIdx, FCacheLastHlTokenCol: Integer; + FCacheLastHlTokenKind: TtkTokenKind; + + FCacheWorkFoldEndLvl: Integer; + FCacheWorkCommentLvl: Integer; + FCacheWorkFoldType: TPascalCodeFoldBlockType; + FCacheWorkFirstLine: Integer; + FCacheWorkSlashCol: Integer; + FCacheWorkCommentStartCol: Integer; + + protected + function IsPasHighlighter: Boolean; + procedure InitCache; + procedure InitPasHighlighter; + // Generic Helpers + function GetFoldEndLevelForIdx(AIndex: Integer): Integer; + function GetFoldCommentLevelForIdx(AIndex: Integer): Integer; + function GetFoldTypeAtEndOfLineForIdx(AIndex: Integer): TPascalCodeFoldBlockType; + function GetFirstCommentLineForIdx(AIndex: Integer): Integer; // Result is 1 based + function GetSlashStartColumnForIdx(AIndex: Integer): Integer; + function GetLastHlTokenForIdx(AIndex: Integer; out APos: Integer): TtkTokenKind; + function GetCommentStartColForIdx(AIndex: Integer): Integer; // Returns Column (logic) for GetFirstCommentLineForIdx(AIndex) + // Values based on FWorkLine + function GetFoldEndLevel: Integer; + function GetFoldCommentLevel: Integer; + function GetFoldTypeAtEndOfLine: TPascalCodeFoldBlockType; + function GetFirstCommentLine: Integer; // Result is 1 based + function GetSlashStartColumn: Integer; // Acts on FWorkLine-1 + function GetCommentStartCol: Integer; // Acts on GetFirstCommentLineForIdx(FWorkLine) / Logical Resulc + + function GetMatchStartColForIdx(AIndex: Integer): Integer; // Res=1-based + function GetMatchStartPos(AIndex: Integer = -1; AForceFirst: Boolean = False): TPoint; // Res=1-based / AIndex-1 is only used for sclMatchPrev + + protected + function GetLine(AnIndex: Integer): String; override; + + procedure DoBeforeCommand(const ACaret: TSynEditCaret; + var Command: TSynEditorCommand); override; + procedure DoAfterCommand(const ACaret: TSynEditCaret; + var Command: TSynEditorCommand; + StartLinePos, EndLinePos: Integer); override; + procedure DoNewLineInString(AStringStartY, AStringStartX: Integer; + const ACaret: TSynEditCaret; + var Command: TSynEditorCommand; + StartLinePos, EndLinePos: Integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Assign(Src: TPersistent); override; + // Retruns a 0-based position (even 0-based physical) + published + // *** coments with (* *) + + (* AnsiIndentFirstLineMax: + * For comments that use any sciAlignOpen... + if AnsiIndentFirstLineMax is is set (none zero): + The indent will be limited to this value + + AnsiIndentFirstLineExtra: + For comments that do NOT start at the BOL, an extra indent is added + on the 2nd line (except if sciAlignOpen is used (in Flags)) + *) + property AnsiIndentMode: TSynCommentIndentFlags read FIndentMode[sctAnsi] + write FIndentMode[sctAnsi]; + property AnsiIndentFirstLineMax: Integer read FIndentFirstLineMax[sctAnsi] + write FIndentFirstLineMax[sctAnsi]; + property AnsiIndentFirstLineExtra: String read FIndentFirstLineExtra[sctAnsi] + write FIndentFirstLineExtra[sctAnsi]; + + (* match should start with ^, and leading spaces should not be in () "^\s?(\*\*?\*?)" + prefix can refer to $1 and should have spaces to indent after the match "$1 " + *) + property AnsiCommentMode: TSynCommentContineMode read FCommentMode[sctAnsi] + write FCommentMode[sctAnsi]; + property AnsiMatch: String read FMatch[sctAnsi] + write FMatch[sctAnsi]; + property AnsiPrefix : String read FPrefix[sctAnsi] + write FPrefix[sctAnsi]; + property AnsiMatchMode: TSynCommentMatchMode read FMatchMode[sctAnsi] + write FMatchMode[sctAnsi]; + property AnsiMatchLine: TSynCommentMatchLine read FMatchLine[sctAnsi] + write FMatchLine[sctAnsi]; + property AnsiCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctAnsi] + write FCommentIndent[sctAnsi]; + + // Add postfix at EOL + property AnsiEolMode: TSynCommentContineMode read FEolMode[sctAnsi] + write FEolMode[sctAnsi]; + property AnsiEolPostfix: String read FEolPostfix[sctAnsi] + write FEolPostfix[sctAnsi]; + property AnsiEolMatch: String read FEolMatch[sctAnsi] + write FEolMatch[sctAnsi]; + property AnsiEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctAnsi] + write FEolSkipLongerLine[sctAnsi]; + + // *** coments with { } + + property BorIndentMode: TSynCommentIndentFlags read FIndentMode[sctBor] + write FIndentMode[sctBor]; + property BorIndentFirstLineMax: Integer read FIndentFirstLineMax[sctBor] + write FIndentFirstLineMax[sctBor]; + property BorIndentFirstLineExtra: String read FIndentFirstLineExtra[sctBor] + write FIndentFirstLineExtra[sctBor]; + + property BorCommentMode: TSynCommentContineMode read FCommentMode[sctBor] + write FCommentMode[sctBor]; + property BorMatch: String read FMatch[sctBor] + write FMatch[sctBor]; + property BorPrefix : String read FPrefix[sctBor] + write FPrefix[sctBor]; + property BorMatchMode: TSynCommentMatchMode read FMatchMode[sctBor] + write FMatchMode[sctBor]; + property BorMatchLine: TSynCommentMatchLine read FMatchLine[sctBor] + write FMatchLine[sctBor]; + property BorCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctBor] + write FCommentIndent[sctBor]; + + property BorEolMode: TSynCommentContineMode read FEolMode[sctBor] + write FEolMode[sctBor]; + property BorEolPostfix : String read FEolPostfix[sctBor] + write FEolPostfix[sctBor]; + property BorEolMatch: String read FEolMatch[sctBor] + write FEolMatch[sctBor]; + property BorEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctBor] + write FEolSkipLongerLine[sctBor]; + + // *** coments with // + // Continue only, if Extended + + property ExtendSlashCommentMode: TSynCommentExtendMode read FExtendSlashCommentMode + write FExtendSlashCommentMode; + + property SlashIndentMode: TSynCommentIndentFlags read FIndentMode[sctSlash] + write FIndentMode[sctSlash]; + property SlashIndentFirstLineMax: Integer read FIndentFirstLineMax[sctSlash] + write FIndentFirstLineMax[sctSlash]; + property SlashIndentFirstLineExtra: String read FIndentFirstLineExtra[sctSlash] + write FIndentFirstLineExtra[sctSlash]; + + property SlashCommentMode: TSynCommentContineMode read FCommentMode[sctSlash] + write FCommentMode[sctSlash]; + property SlashMatch: String read FMatch[sctSlash] + write FMatch[sctSlash]; + property SlashPrefix : String read FPrefix[sctSlash] + write FPrefix[sctSlash]; + property SlashMatchMode: TSynCommentMatchMode read FMatchMode[sctSlash] + write FMatchMode[sctSlash]; + property SlashMatchLine: TSynCommentMatchLine read FMatchLine[sctSlash] + write FMatchLine[sctSlash]; + property SlashCommentIndent: TSynBeautifierIndentType read FCommentIndent[sctSlash] + write FCommentIndent[sctSlash]; + + property SlashEolMode: TSynCommentContineMode read FEolMode[sctSlash] + write FEolMode[sctSlash]; + property SlashEolPostfix : String read FEolPostfix[sctSlash] + write FEolPostfix[sctSlash]; + property SlashEolMatch: String read FEolMatch[sctSlash] + write FEolMatch[sctSlash]; + property SlashEolSkipLongerLine: Boolean read FEolSkipLongerLine[sctSlash] + write FEolSkipLongerLine[sctSlash]; + // String + property StringBreakEnabled: Boolean read FStringBreakEnabled write FStringBreakEnabled; + property StringBreakAppend: String read FStringBreakAppend write FStringBreakAppend; + property StringBreakPrefix: String read FStringBreakPrefix write FStringBreakPrefix; + end; + + +implementation + +{ TSynBeautifierPascal } + +function TSynBeautifierPascal.IsPasHighlighter: Boolean; +begin + Result := (TSynEdit(CurrentEditor).Highlighter <> nil) and + (TSynEdit(CurrentEditor).Highlighter is TSynPasSyn); +end; + +procedure TSynBeautifierPascal.InitCache; +begin + FCacheFoldEndLvlIdx := -1; + FCacheCommentLvlIdx := -1; + FCacheFoldTypeForIdx := -1; + FCacheFirstLineForIdx := -1; + FCacheSlashColumnForIdx := -1; + FCacheCommentStartColForIdx := -1; + + FCacheWorkFoldEndLvl := -2; + FCacheWorkCommentLvl := -2; + FCacheWorkFoldType := cfbtIfThen; // dummy for not yet cached + FCacheWorkFirstLine := -2; + FCacheWorkSlashCol := -2; + FCacheWorkCommentStartCol := -2; + +end; + +procedure TSynBeautifierPascal.InitPasHighlighter; +begin + FPasHighlighter := TSynPasSyn(TSynEdit(CurrentEditor).Highlighter); + FPasHighlighter.CurrentLines := CurrentLines; + FPasHighlighter.ScanRanges; +end; + +function TSynBeautifierPascal.GetFoldEndLevelForIdx(AIndex: Integer): Integer; +begin + Result := FCacheFoldEndLvl; + if AIndex = FCacheFoldEndLvlIdx then + exit; + FCacheFoldEndLvlIdx := AIndex; + FCacheFoldEndLvl := FPasHighlighter.FoldBlockEndLevel(AIndex, FOLDGROUP_PASCAL, [sfbIncludeDisabled]); + Result := FCacheFoldEndLvl; +end; + +function TSynBeautifierPascal.GetFoldCommentLevelForIdx(AIndex: Integer): Integer; +var + tmp: Pointer; + Block: TPascalCodeFoldBlockType; +begin + Result := FCacheCommentLvl; + if AIndex = FCacheCommentLvlIdx then + exit; + FCacheCommentLvlIdx := AIndex; + + FCacheCommentLvl := GetFoldEndLevelForIdx(AIndex) - 1; + while (FCacheCommentLvl > 0) do begin + FPasHighlighter.FoldBlockNestedTypes(AIndex , FCacheCommentLvl - 1, + tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]); + Block:=TPascalCodeFoldBlockType(PtrUInt(tmp)); + if not (Block in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) then + break; + dec(FCacheCommentLvl); + end; + inc(FCacheCommentLvl); + Result := FCacheCommentLvl; +end; + +function TSynBeautifierPascal.GetFoldTypeAtEndOfLineForIdx(AIndex: Integer): TPascalCodeFoldBlockType; +var + EndLevel: Integer; + tmp: Pointer; +begin + // TODO cfbtNestedComment + Result := FCacheFoldType; + if AIndex = FCacheFoldTypeForIdx then + exit; + + FCacheFoldTypeForIdx := AIndex; + EndLevel := GetFoldEndLevelForIdx(AIndex); + if (EndLevel > 0) then + begin + if FPasHighlighter.FoldBlockNestedTypes(AIndex, EndLevel - 1, + tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) + then + FCacheFoldType:=TPascalCodeFoldBlockType(PtrUInt(tmp)) + else + FCacheFoldType := cfbtNone; + end; + + while (FCacheFoldType = cfbtNestedComment) and (EndLevel > 1) do begin + dec(EndLevel); + if FPasHighlighter.FoldBlockNestedTypes(AIndex, EndLevel - 1, + tmp, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) + then + FCacheFoldType:=TPascalCodeFoldBlockType(PtrUInt(tmp)) + else + FCacheFoldType := cfbtNone; + end; + + Result := FCacheFoldType; +end; + +function TSynBeautifierPascal.GetFirstCommentLineForIdx(AIndex: Integer): Integer; +var + FoldType: TPascalCodeFoldBlockType; + ANewIndex, EndLvl, CommentLvl: Integer; +begin + Result := FCacheFirstLine; + if AIndex = FCacheFirstLineForIdx then + exit; + + ANewIndex := AIndex; + FoldType := GetFoldTypeAtEndOfLineForIdx(ANewIndex); + EndLvl := GetFoldEndLevelForIdx(ANewIndex); + + //if (EndLvl = 0) or not(FoldType in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) and + // (AIndex > 0) and (GetSlashStartColumnForIdx(AIndex - 1) > 0) + //then begin + // dec(ANewIndex); + // FoldType := GetFoldTypeAtEndOfLineForIdx(ANewIndex); + // EndLvl := GetFoldEndLevelForIdx(ANewIndex); + //end; + + if (EndLvl = 0) or not(FoldType in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) + then begin + Result := ToPos(AIndex) - 1; // 1 based - the line above ANewIndex + // maybe the line above has a trailing comment + //if (AIndex <> ANewIndex) and (ANewIndex > 0) and (GetSlashStartColumnForIdx(ANewIndex-1) > 0) then + // Result := ToPos(ANewIndex) - 1; + exit; + end; + + FCacheFirstLineForIdx := AIndex; + FCacheFirstLine := ToPos(ANewIndex) - 1; + CommentLvl := GetFoldCommentLevelForIdx(ANewIndex); + + while (FCacheFirstLine > 0) do begin + if CommentLvl > FPasHighlighter.FoldBlockMinLevel(FCacheFirstLine-1, FOLDGROUP_PASCAL, [sfbIncludeDisabled]) then + break; + dec(FCacheFirstLine); + end; + + if FoldType = cfbtSlashComment then begin + // maybe the line above has a trailing comment + if GetSlashStartColumnForIdx(ToIdx(FCacheFirstLine)) > 0 then + dec(FCacheFirstLine); + end; + + Result := FCacheFirstLine; +//debugln(['FIRST LINE ', FCacheFirstLine]); +end; + +function TSynBeautifierPascal.GetSlashStartColumnForIdx(AIndex: Integer): Integer; +var + Tk: TtkTokenKind; +begin + Result := FCacheSlashColumn; + if AIndex = FCacheSlashColumnForIdx then + exit; + + FCacheSlashColumnForIdx := AIndex; + Tk := GetLastHlTokenForIdx(AIndex, FCacheSlashColumn); + if Tk <> SynHighlighterPas.tkComment then + FCacheSlashColumn := -1; + Result := FCacheSlashColumn; +end; + +function TSynBeautifierPascal.GetLastHlTokenForIdx(AIndex: Integer; out + APos: Integer): TtkTokenKind; +begin + Result := FCacheLastHlTokenKind; + APos := FCacheLastHlTokenCol; + if AIndex = FCacheLastHlTokenForIdx then + exit; + + FCacheSlashColumnForIdx := AIndex; + FCacheLastHlTokenKind := SynHighlighterPas.tkUnknown; + FCacheLastHlTokenCol := -1; + if (CurrentLines[AIndex] <> '') then begin + FPasHighlighter.StartAtLineIndex(AIndex); + while not FPasHighlighter.GetEol do begin + FCacheLastHlTokenKind := TtkTokenKind(FPasHighlighter.GetTokenKind); + FCacheLastHlTokenCol := FPasHighlighter.GetTokenPos + 1; + FPasHighlighter.Next; + end; + end; + Result := FCacheLastHlTokenKind; + APos := FCacheLastHlTokenCol; +end; + +function TSynBeautifierPascal.GetCommentStartColForIdx(AIndex: Integer): Integer; +var + nl: TLazSynFoldNodeInfoList; + i: Integer; + FoldCommentLvl: Integer; +begin + Result := FCacheCommentStartCol; + if AIndex = FCacheCommentStartColForIdx then + exit; + FCacheCommentStartColForIdx := AIndex; + + if (GetFoldEndLevelForIdx(AIndex) = 0) or + not(GetFoldTypeAtEndOfLineForIdx(AIndex) in [cfbtAnsiComment, cfbtBorCommand, cfbtSlashComment]) + then begin + // must be SlashComment + FCacheCommentStartCol := GetSlashStartColumnForIdx(AIndex - 1); + //FCacheCommentStartCol := GetSlashStartColumnForIdx(AIndex); + //if FCacheCommentStartCol > 0 then begin + // i := GetSlashStartColumnForIdx(AIndex - 1); + // if i > 0 then + // FCacheCommentStartCol := i; + //end; + Result := FCacheCommentStartCol; +//debugln(['FIRST COL prev-// ', FCacheCommentStartCol]); + exit; + end; + + FCacheCommentStartCol := -1; + FoldCommentLvl := GetFoldCommentLevelForIdx(AIndex); + nl := FPasHighlighter.FoldNodeInfo[GetFirstCommentLineForIdx(AIndex) - 1]; + nl.AddReference; + nl.ClearFilter; + nl.ActionFilter := [sfaOpen]; + nl.GroupFilter := FOLDGROUP_PASCAL; + i := nl.Count - 1; + while i >= 0 do begin + if (not (sfaInvalid in nl[i].FoldAction)) and + (nl[i].NestLvlEnd = FoldCommentLvl) + then begin + FCacheCommentStartCol := nl[i].LogXStart + 1; // Highlighter pos are 0 based + break; + end; + dec(i); + end; + nl.ReleaseReference; +//debugln(['FIRST COL ', FCacheCommentStartCol]); + + Result := FCacheCommentStartCol; +end; + +function TSynBeautifierPascal.GetFoldEndLevel: Integer; +begin + Result := FCacheWorkFoldEndLvl; + if FCacheWorkFoldEndLvl > -2 then + exit; + FCacheWorkFoldEndLvl := GetFoldEndLevelForIdx(FWorkLine-1); + Result := FCacheWorkFoldEndLvl; +end; + +function TSynBeautifierPascal.GetFoldCommentLevel: Integer; +begin + Result := FCacheWorkCommentLvl; + if FCacheWorkCommentLvl > -2 then + exit; + FCacheWorkCommentLvl := GetFoldCommentLevelForIdx(FWorkLine-1); + Result := FCacheWorkCommentLvl; +end; + +function TSynBeautifierPascal.GetFoldTypeAtEndOfLine: TPascalCodeFoldBlockType; +begin + Result := FCacheWorkFoldType; + if FCacheWorkFoldType <> cfbtIfThen then + exit; + FCacheWorkFoldType := GetFoldTypeAtEndOfLineForIdx(FWorkLine-1); + Result := FCacheWorkFoldType; +end; + +function TSynBeautifierPascal.GetFirstCommentLine: Integer; +begin + Result := FCacheWorkFirstLine; + if FCacheWorkFirstLine > -2 then + exit; + FCacheWorkFirstLine := GetFirstCommentLineForIdx(FWorkLine-1); + Result := FCacheWorkFirstLine; +end; + +function TSynBeautifierPascal.GetSlashStartColumn: Integer; +begin + Result := FCacheWorkSlashCol; + if FCacheWorkSlashCol > -2 then + exit; + FCacheWorkSlashCol := GetSlashStartColumnForIdx(FWorkLine-2); + Result := FCacheWorkSlashCol; +end; + +function TSynBeautifierPascal.GetCommentStartCol: Integer; +begin + Result := FCacheWorkCommentStartCol; + if FCacheWorkCommentStartCol > -2 then + exit; + FCacheWorkCommentStartCol := GetCommentStartColForIdx(FWorkLine-1); + Result := FCacheWorkCommentStartCol; +end; + +function TSynBeautifierPascal.GetMatchStartColForIdx(AIndex: Integer): Integer; +begin + if ToPos(AIndex) = GetFirstCommentLine then begin + // Match on FirstLine + case FMatchMode[FWorkFoldType] of + scmMatchAfterOpening: begin + if FWorkFoldType = sctBor + then Result := GetCommentStartCol + 1 + else Result := GetCommentStartCol + 2; + end; + scmMatchOpening: Result := GetCommentStartCol; + scmMatchWholeLine: Result := 1; + scmMatchAtAsterisk: Result := GetCommentStartCol + 1; + end; + end + else begin + // Match on prev, not first + case FMatchMode[FWorkFoldType] of + scmMatchAfterOpening, scmMatchOpening, scmMatchAtAsterisk: + Result := 1 + GetIndentForLine(nil, CurrentLines[AIndex], False); + scmMatchWholeLine: + Result := 1; + end; + end; +end; + +function TSynBeautifierPascal.GetMatchStartPos(AIndex: Integer; AForceFirst: Boolean): TPoint; +begin + if AIndex < 0 then + AIndex := ToIdx(FWorkLine); + + if AForceFirst then + Result.Y := GetFirstCommentLine + else + case FMatchLine[FWorkFoldType] of + sclMatchFirst: Result.Y := GetFirstCommentLine; + sclMatchPrev: Result.Y := ToPos(AIndex)-1; // FWorkLine - 1 + end; + + Result.X := GetMatchStartColForIdx(ToIdx(Result.Y)); +end; + + +function TSynBeautifierPascal.GetLine(AnIndex: Integer): String; +var + ReplacedPrefix: String; + Indent, PreFixPos: Integer; + r: Boolean; + p: TPoint; +begin + if not FGetLineAfterComment then begin + Result := inherited GetLine(AnIndex); + exit; + end; + + // Need to cut of existing Prefix to find indent after prefix + + if AnIndex < GetFirstCommentLine-1 then begin + Result := ''; +//debugln(['GETLINE FROM (< First) ', AnIndex,' ''', CurrentLines[AnIndex], ''' to empty']); + end; + + // 1) Run the match for this line (match prev, or first) + // and see if we can find the replaced prefix in this line + if AnIndex > GetFirstCommentLine-1 then begin + p := GetMatchStartPos(AnIndex); + FRegExprEngine.InputString:= copy(CurrentLines[ToIdx(p.y)], p.x, MaxInt); + FRegExprEngine.Expression := FMatch[FWorkFoldType]; + if FRegExprEngine.ExecPos(1) then begin + ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[FWorkFoldType]); + while (ReplacedPrefix <> '') and (ReplacedPrefix[1] in [#9, ' ']) do + delete(ReplacedPrefix, 1, 1); + while (ReplacedPrefix <> '') and (ReplacedPrefix[length(ReplacedPrefix)] in [#9, ' ']) do + delete(ReplacedPrefix, length(ReplacedPrefix), 1); + if ReplacedPrefix <> '' then begin + Result := CurrentLines[AnIndex]; + PreFixPos := pos(ReplacedPrefix, Result); + if (PreFixPos > 0) and (PreFixPos <= GetMatchStartColForIdx(AnIndex)) then begin + delete(Result, 1, PreFixPos - 1 + Length(ReplacedPrefix)); +//debugln(['GETLINE FROM (1) ', AnIndex,' ''', CurrentLines[AnIndex], ''' to ''', Result, '''']); + exit; + end; + end; + end; + end + else + p := Point(0,0); + + // 2) See, if the current-1 line can be matched + r := False; + Result := CurrentLines[AnIndex]; + Indent := GetMatchStartColForIdx(AnIndex); + FRegExprEngine.InputString:= copy(CurrentLines[AnIndex], Indent, MaxInt); + FRegExprEngine.Expression := FMatch[FWorkFoldType]; + r := FRegExprEngine.ExecPos(1); + if (not r) and (Indent > 1) and + ((p.y <> GetFirstCommentLine) or (FMatchMode[FWorkFoldType] = scmMatchWholeLine)) + then begin + // try whole line +// TODO: only if not first, or if setting + FRegExprEngine.InputString := CurrentLines[AnIndex]; + r := FRegExprEngine.ExecPos(1); + if r then + Indent := 1; + end; + if (r) then begin + Indent := Indent + FRegExprEngine.MatchPos[0] - 1 + FRegExprEngine.MatchLen[0]; + Result := CurrentLines[AnIndex]; + if (Indent <= Length(Result)) then + while (Indent > 1) and (Result[Indent] in [#9, ' ']) do + dec(Indent); + inc(Indent); + if Indent > 0 then begin + Result := copy(Result, Indent, MaxInt); +//debugln(['GETLINE FROM (2) ', AnIndex,' ''', CurrentLines[AnIndex], ''' to ''', Result, '''']); + exit; + end; + end; + + // 3) maybe try currest replace, if different from 1? + + // Nothing found + Result := ''; +//debugln(['GETLINE FROM (X) ', AnIndex,' ''', CurrentLines[AnIndex], ''' to empty']); +end; + +procedure TSynBeautifierPascal.DoBeforeCommand(const ACaret: TSynEditCaret; + var Command: TSynEditorCommand); +begin + FCaretAtEOL := ACaret.BytePos > Length(CurrentLines[ToIdx(ACaret.LinePos)]); + FGetLineAfterComment := False; + inherited DoBeforeCommand(ACaret, Command); +end; + +procedure TSynBeautifierPascal.DoAfterCommand(const ACaret: TSynEditCaret; + var Command: TSynEditorCommand; StartLinePos, EndLinePos: Integer); + +var + WorkLine, PrevLineShlasCol: Integer; + ReplacedPrefix: String; // Each run matches only one Type + MatchResultIntern, MatchedBOLIntern: Array [Boolean] of Boolean; // Each run matches only one Type + + function CheckMatch(AType: TSynCommentType; AFailOnNoPattern: Boolean = False; + AForceFirst: Boolean = False): Boolean; + var + p: TPoint; + begin + if (FMatch[AType] = '') and AFailOnNoPattern then begin + Result := False; + exit; + end; + + if MatchedBOLIntern[AForceFirst] then begin + Result := MatchResultIntern[AForceFirst]; + exit; + end; + + p := GetMatchStartPos(-1, AForceFirst); + + FRegExprEngine.InputString:= copy(CurrentLines[ToIdx(p.y)], p.x, MaxInt); + if (FRegExprEngine.InputString='') then + exit(false); + FRegExprEngine.Expression := FMatch[AType]; + if not FRegExprEngine.ExecPos(1) then begin + ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[AType]); + MatchedBOLIntern[AForceFirst] := True; + MatchResultIntern[AForceFirst] := False; + Result := MatchResultIntern[AForceFirst]; + exit; + end; + + ReplacedPrefix := FRegExprEngine.Substitute(FPrefix[AType]); + MatchedBOLIntern[AForceFirst] := True; + MatchResultIntern[AForceFirst] := True; + Result := MatchResultIntern[AForceFirst]; + + end; + + function IsFoldTypeEnabled(AType: TSynCommentType): Boolean; + begin + Result := ( ( (AType <> sctSlash) or + ( ((not FCaretAtEOL) and (FExtendSlashCommentMode <> sceNever)) or + ((FCaretAtEOL) and not(FExtendSlashCommentMode in [sceNever, sceSplitLine, sceMatchingSplitLine])) + ) + ) and + ( (FIndentMode[AType] <> []) or + (FCommentMode[AType] <> sccNoPrefix) or + (FEolMode[AType] <> sccNoPrefix) + )) + end; + +var + Indent, dummy: Integer; + s: String; + FoldTyp: TSynCommentType; + AnyEnabled: Boolean; + ExtendSlash, BeSmart, Matching: Boolean; + PreviousIsFirst, CommentStartsAtBOL, DidAlignOpen: Boolean; + + IndentTypeBackup: TSynBeautifierIndentType; + +begin + if (EndLinePos < 1) or + ((Command <> ecLineBreak) and (Command <> ecInsertLine)) or + (not IsPasHighlighter) + then begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + exit; + end; + + AnyEnabled := False; + for FoldTyp := low(TSynCommentType) to high(TSynCommentType) do + AnyEnabled := AnyEnabled or IsFoldTypeEnabled(FoldTyp); + if (not AnyEnabled) and (not FStringBreakEnabled) then begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + exit; + end; + + InitCache; + InitPasHighlighter; + FGetLineAfterComment := False; + MatchedBOLIntern[True] := False; + MatchedBOLIntern[False] := False; + PrevLineShlasCol := -1; + dummy := 0; + + if (Command = ecLineBreak) + then WorkLine := ACaret.LinePos + else WorkLine := ACaret.LinePos + 1; + FWorkLine := WorkLine; + + + // Find Foldtype + case GetFoldTypeAtEndOfLine of + cfbtAnsiComment: FoldTyp := sctAnsi; + cfbtBorCommand: FoldTyp := sctBor; + cfbtSlashComment: FoldTyp := sctSlash; + else + begin + if (CurrentLines[ToIdx(WorkLine)-1] <> '') and + (FExtendSlashCommentMode <> sceNever) and + ( (not FCaretAtEOL) or not(FExtendSlashCommentMode in [sceSplitLine, sceMatchingSplitLine]) ) + then begin + PrevLineShlasCol := GetSlashStartColumn; + if PrevLineShlasCol > 0 then + FoldTyp := sctSlash; + end; + if PrevLineShlasCol < 0 then begin + if (CurrentLines[ToIdx(WorkLine)-1] <> '') and + (GetLastHlTokenForIdx(ToIdx(WorkLine)-1, dummy) = SynHighlighterPas.tkString) + then + DoNewLineInString(WorkLine - 1, dummy, ACaret, Command, StartLinePos, EndLinePos) + else + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + exit; + end; + end; + end; + + if not IsFoldTypeEnabled(FoldTyp) then begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + exit; + end; + + FWorkFoldType := FoldTyp; + + // Check if we need extend + ExtendSlash := False; + if (FoldTyp = sctSlash) and (ACaret.OldLineBytePos.x > GetSlashStartColumn+2) then begin + // Check if extension is needed + case FExtendSlashCommentMode of + sceAlways: ExtendSlash := True; + sceSplitLine: ExtendSlash := not FCaretAtEOL; + sceMatching: ExtendSlash := CheckMatch(FoldTyp); + sceMatchingSplitLine: ExtendSlash := CheckMatch(FoldTyp) and (not FCaretAtEOL); + end; + + if not ExtendSlash then begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + exit; + end; + end; + + // Indent + Matching := CheckMatch(FoldTyp); + PreviousIsFirst := (GetFirstCommentLine = WorkLine -1); + DidAlignOpen := False; + CommentStartsAtBOL := True; + if PreviousIsFirst then + CommentStartsAtBOL := GetCommentStartCol = 1 + GetIndentForLine(nil, CurrentLines[ToIdx(GetFirstCommentLine)], False); + + + // Aply indent before prefix + if Matching or (FCommentMode[FoldTyp] = sccPrefixAlways) or (sciApplyIndentForNoMatch in FIndentMode[FoldTyp]) + then begin + IndentTypeBackup := IndentType; + try + if IndentType = sbitPositionCaret then + IndentType := sbitSpace; + if IndentType = sbitConvertToTabOnly then + IndentType := sbitConvertToTabSpace; + + // Align with open + if ( (FIndentMode[FoldTyp] * [sciNone, sciAlignOpen] = [sciAlignOpen]) or + ( (sciAlignOpenOnce in FIndentMode[FoldTyp]) and PreviousIsFirst ) + ) and + ( (not (sciAlignOpenSkipBOL in FIndentMode[FoldTyp])) or (not CommentStartsAtBOL) ) + then begin + Indent := CurrentLines.LogicalToPhysicalCol(CurrentLines[ToIdx(GetFirstCommentLine)], + ToIdx(GetFirstCommentLine), + GetCommentStartCol-1); + if FIndentFirstLineMax[FoldTyp] > 0 + then Indent := Min(Indent, FIndentFirstLineMax[FoldTyp]); + s := GetCharMix(WorkLine, Indent, dummy); + FLogicalIndentLen := length(s); + CurrentLines.EditInsert(1, WorkLine, s); + DidAlignOpen := True; + end + else + // Do not align with open, but check MaxIndent + if PreviousIsFirst and (FIndentFirstLineMax[FoldTyp] > 0) and + (FIndentMode[FoldTyp] * [sciNone] = []) then begin + Indent := GetIndentForLine(nil, CurrentLines[ToIdx(WorkLine-1)], False); + Indent := Min(Indent, FIndentFirstLineMax[FoldTyp]); + s := GetCharMix(WorkLine, Indent, dummy); + FLogicalIndentLen := length(s); + CurrentLines.EditInsert(1, WorkLine, s); + end + else + if (sciNone in FIndentMode[FoldTyp]) then begin + // No indent + end + else + begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + end; + finally + IndentType := IndentTypeBackup; + end; + + // AnsiIndentFirstLineExtra + if PreviousIsFirst and (not CommentStartsAtBOL) and (not DidAlignOpen) then begin + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, FIndentFirstLineExtra[FoldTyp]); + FLogicalIndentLen := FLogicalIndentLen + length(FIndentFirstLineExtra[FoldTyp]); + end; + + end + else + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + + Indent := 0; // Extra Indent + BeSmart := (PreviousIsFirst or (sciAlignOpen in FIndentMode[FoldTyp])) and + (Matching or ExtendSlash or (sciApplyIndentForNoMatch in FIndentMode[FoldTyp]) or + (FCommentMode[FoldTyp] = sccPrefixAlways) ); + + // sciAddTokenLen -- Spaces for (* or { + if BeSmart and + ( (sciAddTokenLen in FIndentMode[FoldTyp]) and + ( (not(sciMatchOnlyTokenLen in FIndentMode[FoldTyp])) or CheckMatch(FoldTyp, False, True) ) and + ( (not(sciAlignOnlyTokenLen in FIndentMode[FoldTyp])) or DidAlignOpen ) + ) + then begin + case FoldTyp of + sctAnsi: if FMatchMode[FoldTyp] = scmMatchAtAsterisk + then Indent := 1 + else Indent := 2; + sctBor: Indent := 1; + sctSlash: if ExtendSlash + then Indent := 0 // do the slashes + else Indent := 2; + end; + end; + + // sciAddPastTokenIndent -- Spaces from after (* or { (to go before prefix e.g " { * foo") + if BeSmart and + ( (sciAddPastTokenIndent in FIndentMode[FoldTyp]) and + ( (not(sciMatchOnlyPastTokenIndent in FIndentMode[FoldTyp])) or CheckMatch(FoldTyp, False, True) ) and + ( (not(sciAlignOnlyPastTokenIndent in FIndentMode[FoldTyp])) or DidAlignOpen ) + ) and + (GetCommentStartCol > 0) // foundStartCol + then begin + case FoldTyp of + // ignores scmMatchAtAsterisk + sctAnsi: s := copy(CurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+2, MaxInt); + sctBor: s := copy(CurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+1, MaxInt); + sctSlash: s := copy(CurrentLines[ToIdx(GetFirstCommentLine)], GetCommentStartCol+2, MaxInt); + end; + Indent := Indent + GetIndentForLine(nil, s, False); + end; + // Extend // + if ExtendSlash then begin + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, '//'); + FLogicalIndentLen := FLogicalIndentLen + 2; + end; + if (Indent > 0) then begin + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, StringOfChar(' ', Indent )); + FLogicalIndentLen := FLogicalIndentLen + Indent; + end; + + // Apply prefix + if (FCommentMode[FoldTyp] = sccPrefixAlways) or + ((FCommentMode[FoldTyp] = sccPrefixMatch) and Matching) + then begin + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, ReplacedPrefix); + FLogicalIndentLen := FLogicalIndentLen + length(ReplacedPrefix); + + // Post prefix indent + FGetLineAfterComment := True; + try + GetIndentInfo(WorkLine, s, Indent, GetFirstCommentLine); + if s <> '' then begin + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine, s); + FLogicalIndentLen := FLogicalIndentLen + length(s); // logical (Indent is phisical) + end + else + FLogicalIndentLen := FLogicalIndentLen + Indent; // maybe position caret + finally + FGetLineAfterComment := False; + end; + end; + + + if (Command = ecLineBreak) then begin + ACaret.IncForcePastEOL; + ACaret.BytePos := 1 + FLogicalIndentLen; + ACaret.DecForcePastEOL; + end; + +end; + +procedure TSynBeautifierPascal.DoNewLineInString(AStringStartY, AStringStartX: Integer; + const ACaret: TSynEditCaret; var Command: TSynEditorCommand; StartLinePos, + EndLinePos: Integer); +var + s: String; + WorkLine: Integer; + f: Boolean; +begin + inherited DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos); + if not FStringBreakEnabled then + exit; + + if (Command = ecLineBreak) + then WorkLine := ACaret.LinePos - 1 + else WorkLine := ACaret.LinePos; + + s := CurrentLines[ToIdx(WorkLine)]; + if (AStringStartX < 1) or (AStringStartX > Length(s)) or (s[AStringStartX] <> '''') then + exit; + f := False; + while AStringStartX <= length(s) do begin + if (s[AStringStartX] = '''') then f := not f; + inc(AStringStartX); + end; + if not f then exit; + + ACaret.IncForcePastEOL; + + CurrentLines.EditInsert(1 + length(s), WorkLine, '''' + FStringBreakAppend); + //if Command = ecInsertLine then + // ACaret.BytePos := ACaret.BytePos + Length(FStringBreakAppend) + 1; + + CurrentLines.EditInsert(1 + FLogicalIndentLen, WorkLine + 1, FStringBreakPrefix + ''''); + if (Command = ecLineBreak) then + ACaret.BytePos := ACaret.BytePos + Length(FStringBreakPrefix) + 1; + + ACaret.DecForcePastEOL; +end; + +constructor TSynBeautifierPascal.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FRegExprEngine := TRegExpr.Create; + FRegExprEngine.ModifierI := True; + + FIndentMode[sctAnsi] := [sciAddTokenLen, sciAddPastTokenIndent]; + FIndentFirstLineExtra[sctAnsi] := ''; + FIndentFirstLineMax[sctAnsi] := 0; + + FCommentMode[sctAnsi] := sccPrefixMatch; + FMatch[sctAnsi] := '^ ?(\*)'; + FMatchMode[sctAnsi] := scmMatchAfterOpening; + FMatchLine[sctAnsi] := sclMatchPrev; + FPrefix[sctAnsi] := '$1'; + + FEolMatch[sctAnsi] := ''; + FEolMode[sctAnsi] := sccNoPrefix; + FEolPostfix[sctAnsi] := ''; + FEolSkipLongerLine[sctAnsi] := False; + + + FIndentMode[sctBor] := [sciAddTokenLen, sciAddPastTokenIndent]; + FIndentFirstLineExtra[sctBor] := ''; + FIndentFirstLineMax[sctBor] := 0; + + FCommentMode[sctBor] := sccPrefixMatch; + FMatch[sctBor] := '^ ?(\*)'; + FMatchMode[sctBor] := scmMatchAfterOpening; + FMatchLine[sctBor] := sclMatchPrev; + FPrefix[sctBor] := '$1'; + + FEolMatch[sctBor] := ''; + FEolMode[sctBor] := sccNoPrefix; + FEolPostfix[sctBor] := ''; + FEolSkipLongerLine[sctBor] := False; + + + FExtendSlashCommentMode := sceNever; + + FIndentMode[sctSlash] := []; + FIndentFirstLineExtra[sctSlash] := ''; + FIndentFirstLineMax[sctSlash] := 0; + + FCommentMode[sctSlash] := sccPrefixMatch; + FMatch[sctSlash] := '^ ?(\*)'; + FMatchMode[sctSlash] := scmMatchAfterOpening; + FMatchLine[sctSlash] := sclMatchPrev; + FPrefix[sctSlash] := '$1'; + + FEolMatch[sctSlash] := ''; + FEolMode[sctSlash] := sccNoPrefix; + FEolPostfix[sctSlash] := ''; + FEolSkipLongerLine[sctSlash] := False; + + FStringBreakEnabled := False; + FStringBreakAppend := ' +'; + FStringBreakPrefix := ''; +end; + +destructor TSynBeautifierPascal.Destroy; +begin + inherited Destroy; + FreeAndNil(FRegExprEngine); +end; + +procedure TSynBeautifierPascal.Assign(Src: TPersistent); +var + i: TSynCommentType; +begin + inherited Assign(Src); + if not(Src is TSynBeautifierPascal) then exit; + + FExtendSlashCommentMode := TSynBeautifierPascal(Src).FExtendSlashCommentMode; + + for i := low(TSynCommentType) to high(TSynCommentType) do begin + FIndentMode[i] := TSynBeautifierPascal(Src).FIndentMode[i]; + FIndentFirstLineExtra[i] := TSynBeautifierPascal(Src).FIndentFirstLineExtra[i]; + FIndentFirstLineMax[i] := TSynBeautifierPascal(Src).FIndentFirstLineMax[i]; + + FCommentMode[i] := TSynBeautifierPascal(Src).FCommentMode[i]; + FMatch[i] := TSynBeautifierPascal(Src).FMatch[i]; + FMatchMode[i] := TSynBeautifierPascal(Src).FMatchMode[i]; + FMatchLine[i] := TSynBeautifierPascal(Src).FMatchLine[i]; + FPrefix[i] := TSynBeautifierPascal(Src).FPrefix[i]; + + FEolMatch[i] := TSynBeautifierPascal(Src).FEolMatch[i]; + FEolMode[i] := TSynBeautifierPascal(Src).FEolMode[i]; + FEolPostfix[i] := TSynBeautifierPascal(Src).FEolPostfix[i]; + FEolSkipLongerLine[i] := TSynBeautifierPascal(Src).FEolSkipLongerLine[i]; + end; + + FStringBreakAppend := TSynBeautifierPascal(Src).FStringBreakAppend; + FStringBreakEnabled := TSynBeautifierPascal(Src).FStringBreakEnabled; + FStringBreakPrefix := TSynBeautifierPascal(Src).FStringBreakPrefix; + +end; + +end. + diff --git a/components/synedit/synedit.lpk b/components/synedit/synedit.lpk index 24458da914..531ae53ae0 100644 --- a/components/synedit/synedit.lpk +++ b/components/synedit/synedit.lpk @@ -35,7 +35,7 @@ Alternatively, the contents of these files may be used under the terms of the GN If you wish to allow use of your version of these files only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL. "/> - + @@ -385,6 +385,10 @@ If you wish to allow use of your version of these files only under the terms of + + + +