lazarus/components/synedit/synbeautifier.pas
2015-03-30 22:57:32 +00:00

1811 lines
66 KiB
ObjectPascal

{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: SynHighlighterGeneral.pas, released 2000-04-07.
The Original Code is based on the mwGeneralSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Martin Waldenburg.
Portions written by Martin Waldenburg are copyright 1999 Martin Waldenburg.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.
Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file 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.
$Id: SynHighlighterGeneral.pas,v 1.3 2000/11/08 22:09:59 mghie Exp $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
}
unit SynBeautifier;
{$I synedit.inc}
interface
uses
Classes, SysUtils, LCLProc, SynEditMiscClasses, SynEditMiscProcs, LazSynEditText, SynEditPointClasses,
SynEditKeyCmds, SynHighlighterPas, SynEditHighlighterFoldBase, SynRegExpr;
type
TSynCustomBeautifier = class;
// Callback for indent
TSynBeautifierSetIndentProc =
procedure(
(* LinePos:
1-based, the line that should be changed *)
LinePos: Integer;
(* Indent:
New indent in spaces (Logical = Physical *)
Indent: Integer;
(* RelativeToLinePos:
Indent specifies +/- offset from indent on RTLine (0: for absolute indent) *)
RelativeToLinePos: Integer = 0;
(* IndentChars:
String used to build indent; maybe empty, single char, or string (usually 1 tab or 1 space)
The String will be repeated and cut as needed, then filled with spaces at the end
* NOTE: If this is specified the TSynBeautifierIndentType is ignored
*)
IndentChars: String = '';
(* IndentCharsFromLinePos:
Use tab/space mix from this Line for indent (if specified > 0)
"IndentChars" will only be used, if the found tab/space mix is to short
* NOTE: If this is specified the TSynBeautifierIndentType is ignored
*)
IndentCharsFromLinePos: Integer = 0
) of object;
// Event triggered if Lines may needs Indend
TSynBeautifierGetIndentEvent =
function(
Sender: TObject; // the beautifier
Editor: TObject; // the synedit
LogCaret, OldLogCaret: TPoint; // Caret after and before the edit action
FirstLinePos, LastLinePos: Integer; // Changed lines. this can include lines outside the range of OldLogCaret to LogCaret
Reason: TSynEditorCommand; // what caused the event
SetIndentProc: TSynBeautifierSetIndentProc
): boolean of object;
{ TSynCustomBeautifier }
TSynCustomBeautifier = class(TComponent)
private
FAutoIndent: Boolean;
FOnGetDesiredIndent: TSynBeautifierGetIndentEvent;
FCurrentEditor: TSynEditBase; // For callback / applyIndent
FCurrentLines: TSynEditStrings;
protected
procedure DoBeforeCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand); virtual; abstract;
procedure DoAfterCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand;
StartLinePos, EndLinePos: Integer); virtual; abstract;
property CurrentEditor: TSynEditBase read FCurrentEditor;
property CurrentLines: TSynEditStrings read FCurrentLines;
public
procedure Assign(Src: TPersistent); override;
function GetCopy: TSynCustomBeautifier;
procedure BeforeCommand(const Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret; var Command: TSynEditorCommand;
InitialCmd: TSynEditorCommand);
procedure AfterCommand(const Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret; var Command: TSynEditorCommand;
InitialCmd: TSynEditorCommand; StartLinePos, EndLinePos: Integer);
// GetDesiredIndentForLine: Returns the 1-based Physical x pos
function GetDesiredIndentForLine
(Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret): Integer; virtual; abstract;
function GetDesiredIndentForLine
(Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret; out ReplaceIndent: Boolean;
out DesiredIndent: String): Integer; virtual; abstract;
property OnGetDesiredIndent: TSynBeautifierGetIndentEvent
read FOnGetDesiredIndent write FOnGetDesiredIndent;
property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
end;
TSynCustomBeautifierClass = class of TSynCustomBeautifier;
TSynBeautifierIndentType = (
sbitSpace, sbitCopySpaceTab,
sbitPositionCaret,
sbitConvertToTabSpace, // convert to tabs, fill with spcaces if needed
sbitConvertToTabOnly // convert to tabs, even if shorter
);
{ TSynBeautifier }
TSynBeautifier = class(TSynCustomBeautifier)
private
FIndentType: TSynBeautifierIndentType;
protected
FLogicalIndentLen: Integer;
function GetLine(AnIndex: Integer): String; virtual;
procedure GetIndentInfo(const LinePos: Integer;
out ACharMix: String; out AnIndent: Integer;
AStopScanAtLine: Integer = 0);
// requiring FCurrentEditor, FCurrentLines
procedure DoBeforeCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand); override;
procedure DoAfterCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand;
StartLinePos, EndLinePos: Integer); override;
function GetIndent(const LinePos: Integer; out BasedOnLine: Integer;
AStopScanAtLine: Integer = 0): Integer;
function AdjustCharMix(DesiredIndent: Integer; CharMix, AppendMix: String): String;
function CreateTabSpaceMix(var DesiredIndent: Integer; OnlyTabs: Boolean): String;
function GetCharMix(const LinePos: Integer; var Indent: Integer;
var IndentCharsFromLinePos: Integer;
ModifyIndent: Boolean = False): String;
procedure ApplyIndent(LinePos: Integer; Indent: Integer;
RelativeToLinePos: Integer = 0; IndentChars: String = '';
IndentCharsFromLinePos: Integer = 0);
function UnIndentLine(const ACaret: TSynEditCaret; out CaretNewX: Integer): Boolean;
public
procedure Assign(Src: TPersistent); override;
// Retruns a 0-based position (even 0-based physical)
function GetIndentForLine(Editor: TSynEditBase; const Line: string;
Physical: boolean): Integer;
function GetDesiredIndentForLine
(Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret): Integer; override;
function GetDesiredIndentForLine
(Editor: TSynEditBase; const Lines: TSynEditStrings;
const ACaret: TSynEditCaret; out ReplaceIndent: Boolean;
out DesiredIndent: String): Integer; override;
published
property IndentType: TSynBeautifierIndentType read FIndentType write FIndentType;
end;
TSynCommentContineMode = (
sccNoPrefix, // May still do indent, if matched
sccPrefixAlways, // If the pattern did not match all will be done, except the indent AFTER the prefix (can not be detected)
sccPrefixMatch
//sccPrefixMatchFirst
//sccPrefixMatchPrev
//sccPrefixMatchPrevTwo // last 2 lines match
//sccPrefixMatchPrevTwoExact // last 2 lines match and same result for prefix
);
TSynCommentMatchLine = (
sclMatchFirst, // Match the first line of the comment to get substitutes for Prefix ($1)
sclMatchPrev // Match the previous line of the comment to get substitutes for Prefix ($1)
//sclMatchNestedFirst // For nested comments, first line of this nest.
);
TSynCommentMatchMode = (
// Which parts of the first line to match sclMatchFirst or sclMatchPrev (if prev = first)
scmMatchAfterOpening, // will not include (*,{,//. The ^ will match the first char after
scmMatchOpening, // will include (*,{,//. The ^ will match the ({/
scmMatchWholeLine, // Match the entire line
scmMatchAtAsterisk // AnsiComment only, will match the * of (*, but not the (
);
TSynCommentIndentFlag = (
// * For Matching lines (FCommentMode)
// By default indent is the same as for none comment lines (none overrides sciAlignOpen)
sciNone, // Does not Indent comment lines (Prefix may contain a fixed indent)
sciAlignOpen, // Indent to real opening pos on first line, if comment does not start at BOL "Foo(); (*"
// Will force every new line back to Align.
// To align only once, use IndentFirstLineExtra=MaxInt
// sciAdd...: if (only if) previous line had started with the opening token "(*" or "{".
// or if sciAlignOpen is set
// This is not done for "//", as Comment Extension will add a new "//"
// But Applies to sciNone
sciAddTokenLen, // add 1 or 2 spaces to indent (for the length of the token)
// in case of scmMatchAtAsterisk, 1 space is added. ("(" only)
sciAddPastTokenIndent, // Adds any indent found past the opening token "(*", "{" or "//".
// For "//" this is added after the nem "//", but before the prefix.
sciMatchOnlyTokenLen, // Apply the Above only if first line matches. (Only if sciAddTokenLen is specified)
sciMatchOnlyPastTokenIndent,
sciAlignOnlyTokenLen, // Apply the Above only if sciAlignOpen was used (include via max)
sciAlignOnlyPastTokenIndent,
// flag to ignore spaces, that are matched.
// flag to be smart, if not matched
sciApplyIndentForNoMatch // Apply above rules For NONE Matching lines (FCommentMode),
// includes FIndentFirstLineExtra
);
TSynCommentIndentFlags = set of TSynCommentIndentFlag;
TSynCommentExtendMode = (
sceNever, // Never Extend
sceAlways, // Always
sceSplitLine, // If the line was split (caret was not at EOL, when enter was pressed
sceMatching, // If the line matched (even if sccPrefixAlways or sccNoPrefix
sceMatchingSplitLine
);
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 do NOT start at the BOL in their opening line " Foo; ( * comment":
if AnsiIndentFirstLineMax is is set:
- If the comment starts before or at the "Max-Column, then sciAlignOpen is always used.
- If the comment starts after max column, then the specified mode is used.
If the specified mode is sciAlignOpen it will be cut at Max
* For comments that start at BOL in their opening line " ( * comment":
This is ignored
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, or via A.I.FirstLineMax))
*)
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;
function dbgs(AMatchLine: TSynCommentMatchLine): String; overload;
function dbgs(AMatchMode: TSynCommentMatchMode): String; overload;
function dbgs(AIndentFlag: TSynCommentIndentFlag): String; overload;
function dbgs(AIndentFlags: TSynCommentIndentFlags): String; overload;
function dbgs(AExtendMode: TSynCommentExtendMode): String; overload;
implementation
uses SynEdit;
function dbgs(ACommentType: TSynCommentType): String;
begin
Result := ''; WriteStr(Result, ACommentType);
end;
function dbgs(AContinueMode: TSynCommentContineMode): String;
begin
Result := ''; WriteStr(Result, AContinueMode);
end;
function dbgs(AMatchLine: TSynCommentMatchLine): String;
begin
Result := ''; WriteStr(Result, AMatchLine);
end;
function dbgs(AMatchMode: TSynCommentMatchMode): String;
begin
Result := ''; WriteStr(Result, AMatchMode);
end;
function dbgs(AIndentFlag: TSynCommentIndentFlag): String;
begin
Result := ''; WriteStr(Result, AIndentFlag);
end;
function dbgs(AIndentFlags: TSynCommentIndentFlags): String;
var
i: TSynCommentIndentFlag;
begin
Result := '';
for i := low(TSynCommentIndentFlag) to high(TSynCommentIndentFlag) do
if i in AIndentFlags then
if Result = ''
then Result := dbgs(i)
else Result := Result + ',' + dbgs(i);
if Result <> '' then
Result := '[' + Result + ']';
end;
function dbgs(AExtendMode: TSynCommentExtendMode): String;
begin
Result := ''; WriteStr(Result, AExtendMode);
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;
// 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);
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, IsAtBOL, 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;
IsAtBOL := True;
if PreviousIsFirst then
IsAtBOL := 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;
if PreviousIsFirst and not IsAtBOL and
(FIndentFirstLineMax[FoldTyp] > 0) and
( (FIndentFirstLineMax[FoldTyp] + 1 >= GetCommentStartCol) or
(FIndentMode[FoldTyp] * [sciNone, sciAlignOpen] = [sciAlignOpen])
)
then begin
// Use sciAlignOpen
Indent := Min(
FCurrentLines.LogicalToPhysicalCol(FCurrentLines[ToIdx(GetFirstCommentLine)], ToIdx(GetFirstCommentLine), GetCommentStartCol-1),
FIndentFirstLineMax[FoldTyp]);
s := GetCharMix(WorkLine, Indent, dummy);
FLogicalIndentLen := length(s);
FCurrentLines.EditInsert(1, WorkLine, s);
DidAlignOpen := True;
end
else
if (FIndentMode[FoldTyp] * [sciNone, sciAlignOpen] = [sciAlignOpen]) and
(GetCommentStartCol > 0)
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
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 IsAtBOL) 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 befare 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);
begin
if assigned(Src) and (src is TSynCustomBeautifier) then begin
FCurrentEditor := TSynCustomBeautifier(Src).FCurrentEditor;
FCurrentLines := TSynCustomBeautifier(Src).FCurrentLines;
FOnGetDesiredIndent := TSynCustomBeautifier(Src).FOnGetDesiredIndent;
FAutoIndent := TSynCustomBeautifier(Src).FAutoIndent;
end
else
inherited;
end;
function TSynCustomBeautifier.GetCopy: TSynCustomBeautifier;
begin
// Since all synedits share one beautifier, create a temp instance.
// Todo: have individual beautifiers
Result := TSynCustomBeautifierClass(self.ClassType).Create(nil);
Result.assign(self);
end;
procedure TSynCustomBeautifier.BeforeCommand(const Editor: TSynEditBase;
const Lines: TSynEditStrings; const ACaret: TSynEditCaret;
var Command: TSynEditorCommand; InitialCmd: TSynEditorCommand);
begin
// Must be called on GetCopy
// Todo: have individual beautifiers
FCurrentEditor := Editor;
FCurrentLines := Lines;
DoBeforeCommand(ACaret, Command);
end;
procedure TSynCustomBeautifier.AfterCommand(const Editor: TSynEditBase;
const Lines: TSynEditStrings; const ACaret: TSynEditCaret;
var Command: TSynEditorCommand; InitialCmd: TSynEditorCommand;
StartLinePos, EndLinePos: Integer);
begin
// Must be called on GetCopy
// Todo: have individual beautifiers
FCurrentEditor := Editor;
FCurrentLines := Lines;
DoAfterCommand(ACaret, Command, StartLinePos, EndLinePos);
end;
{ TSynBeautifier }
procedure TSynBeautifier.Assign(Src: TPersistent);
begin
inherited Assign(Src);
if assigned(Src) and (src is TSynBeautifier) then begin
FIndentType := TSynBeautifier(Src).FIndentType;
FCurrentEditor := TSynBeautifier(Src).FCurrentEditor;
FCurrentLines := TSynBeautifier(Src).FCurrentLines;
end;
end;
function TSynBeautifier.GetLine(AnIndex: Integer): String;
begin
Result := FCurrentLines[AnIndex];
end;
procedure TSynBeautifier.GetIndentInfo(const LinePos: Integer; out ACharMix: String; out
AnIndent: Integer; AStopScanAtLine: Integer);
var
b: Integer;
begin
ACharMix := '';
if (GetLine(LinePos-2) = '') and (GetLine(LinePos-1) <> '') then
AnIndent := 0
else
AnIndent := GetIndent(LinePos, b, AStopScanAtLine);
if AnIndent > 0 then begin
ACharMix := GetCharMix(LinePos, AnIndent, b, True);
if (FIndentType = sbitPositionCaret) and (GetLine(LinePos-1) = '') then
ACharMix := '';
end;
end;
procedure TSynBeautifier.DoBeforeCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand);
var
x: Integer;
begin
if (Command = ecDeleteLastChar) and
(FAutoIndent) and
(ACaret.CharPos > 1) and
(not TCustomSynEdit(FCurrentEditor).ReadOnly) and
( (not TCustomSynEdit(FCurrentEditor).SelAvail) or
(eoPersistentBlock in TCustomSynEdit(FCurrentEditor).Options2) ) and
(GetIndentForLine(FCurrentEditor, ACaret.LineText, True) = ACaret.CharPos - 1)
then begin
FCurrentLines.UndoList.CurrentReason := ecSmartUnindent;
UnIndentLine(ACaret, x);
ACaret.CharPos := x;
Command := ecNone;
end;
end;
procedure TSynBeautifier.DoAfterCommand(const ACaret: TSynEditCaret;
var Command: TSynEditorCommand; StartLinePos, EndLinePos: Integer);
var
y, Indent: Integer;
s: String;
begin
FLogicalIndentLen := 0;
if EndLinePos < 1 then
exit;
if assigned(FOnGetDesiredIndent) and
FOnGetDesiredIndent(self, FCurrentEditor, ACaret.LineBytePos,
ACaret.OldLineBytePos, StartLinePos, EndLinePos, Command,
@ApplyIndent)
then
exit;
if ((Command = ecLineBreak) or (Command = ecInsertLine)) and FAutoIndent then begin
if (Command = ecLineBreak) then
y := ACaret.LinePos
else
y := ACaret.LinePos + 1;
GetIndentInfo(y, s, Indent);
if s <> '' then begin;
FCurrentLines.EditInsert(1, y, s);
FLogicalIndentLen := length(s);
end;
if (Command = ecLineBreak) then begin
ACaret.IncForcePastEOL;
ACaret.CharPos := Indent + 1;
ACaret.DecForcePastEOL;
end;
end;
end;
function TSynBeautifier.UnIndentLine(const ACaret: TSynEditCaret;
out CaretNewX: Integer): Boolean;
var
SpaceCount1, SpaceCount2: Integer;
BackCounter, LogSpacePos, FillSpace: Integer;
LogCaret: TPoint;
Line, Temp: String;
begin
Line := ACaret.LineText;
SpaceCount1 := GetIndentForLine(FCurrentEditor, Line, true); // physical, desired pos
SpaceCount2 := 0;
if (SpaceCount1 > 0) then begin
BackCounter := ACaret.LinePos - 2;
while BackCounter >= 0 do begin
Temp := FCurrentLines[BackCounter];
SpaceCount2 := GetIndentForLine(FCurrentEditor, Temp, true);
if (SpaceCount2 < SpaceCount1) and (temp <> '') then
break;
Dec(BackCounter);
end;
end;
if SpaceCount2 >= SpaceCount1 then
SpaceCount2 := 0;
// remove visible spaces
LogSpacePos := FCurrentLines.PhysicalToLogicalCol(Line, ACaret.LinePos-1, SpaceCount2 + 1);
FillSpace := SpaceCount2 + 1 - FCurrentLines.LogicalToPhysicalCol(Line, ACaret.LinePos-1, LogSpacePos);
LogCaret := ACaret.LineBytePos;
CaretNewX := SpaceCount2 + 1;
FCurrentLines.EditDelete(LogSpacePos, ACaret.LinePos, LogCaret.X - LogSpacePos);
if FillSpace > 0 then
FCurrentLines.EditInsert(LogSpacePos, ACaret.LinePos, StringOfChar(' ', FillSpace));
Result := True;
end;
function TSynBeautifier.GetIndent(const LinePos: Integer; out BasedOnLine: Integer;
AStopScanAtLine: Integer): Integer;
var
Temp: string;
begin
if AStopScanAtLine > 0 then
dec(AStopScanAtLine); // Convert to index
BasedOnLine := LinePos - 1; // Convert to index
while (BasedOnLine > AStopScanAtLine) do begin
dec(BasedOnLine);
Temp := GetLine(BasedOnLine);
if Temp <> '' then begin
Result := GetIndentForLine(FCurrentEditor, Temp, True);
exit;
end;
end;
Result := 0;
//BasedOnLine := LinePos;
//Result := GetIndentForLine(FCurrentEditor, GetLine(BasedOnLine), True);
end;
function TSynBeautifier.AdjustCharMix(DesiredIndent: Integer; CharMix, AppendMix: String): String;
var
i: Integer;
CurLen: Integer;
begin
CurLen := FCurrentLines.LogicalToPhysicalCol(CharMix, -1, length(CharMix)+1) - 1; // TODO: Need the real index of the line
if AppendMix <> '' then begin
while CurLen < DesiredIndent do begin
CharMix := CharMix + AppendMix;
CurLen := FCurrentLines.LogicalToPhysicalCol(CharMix, -1, length(CharMix)+1) - 1; // TODO: Need the real index of the line
end
end;
i := length(CharMix);
while CurLen > DesiredIndent do begin
Dec(i);
CurLen := FCurrentLines.LogicalToPhysicalCol(CharMix, -1, i+1) - 1; // TODO: Need the real index of the line
end;
CharMix := copy(CharMix, 1, i) + StringOfChar(' ', DesiredIndent - CurLen);
Result := CharMix;
end;
function TSynBeautifier.CreateTabSpaceMix(var DesiredIndent: Integer;
OnlyTabs: Boolean): String;
var
CurLen: Integer;
begin
CurLen := 0;
Result := '';
while CurLen < DesiredIndent do begin
Result := Result + #9;
CurLen := FCurrentLines.LogicalToPhysicalCol(Result, -1, length(Result)+1) - 1; // TODO: Need the real index of the line
end;
if CurLen = DesiredIndent then
exit;
Delete(Result, Length(Result), 1);
if OnlyTabs then begin
CurLen := FCurrentLines.LogicalToPhysicalCol(Result, -1, length(Result)+1) - 1; // TODO: Need the real index of the line
DesiredIndent := CurLen;
exit;
end;
repeat
Result := Result + ' ';
CurLen := FCurrentLines.LogicalToPhysicalCol(Result, -1, length(Result)+1) - 1; // TODO: Need the real index of the line
until CurLen >= DesiredIndent;
end;
function TSynBeautifier.GetCharMix(const LinePos: Integer; var Indent: Integer;
var IndentCharsFromLinePos: Integer; ModifyIndent: Boolean): String;
var
Temp, KnownMix, BasedMix: string;
KnownPhysLen, PhysLen: Integer;
BackCounter: LongInt;
OrigIndent: Integer;
begin
OrigIndent := Indent;
case FIndentType of
sbitSpace, sbitPositionCaret:
begin
IndentCharsFromLinePos := 0;
Result := StringOfChar(' ', Indent);
if not ModifyIndent then Indent := OrigIndent;
exit;
end;
sbitConvertToTabSpace:
begin
IndentCharsFromLinePos := 0;
Result := CreateTabSpaceMix(Indent, False);
exit;
if not ModifyIndent then Indent := OrigIndent;
end;
sbitConvertToTabOnly:
begin
IndentCharsFromLinePos := 0;
Result := CreateTabSpaceMix(Indent, True);
if not ModifyIndent then Indent := OrigIndent;
exit;
end;
end;
if (IndentCharsFromLinePos > 0) and (IndentCharsFromLinePos <= FCurrentLines.Count) then
begin
Temp := GetLine(IndentCharsFromLinePos);
KnownMix := copy(Temp, 1, GetIndentForLine(FCurrentEditor, Temp, False));
end
else
KnownMix := '';
BasedMix := KnownMix;
KnownPhysLen := GetIndentForLine(FCurrentEditor, KnownMix, True);
BackCounter := LinePos;
while (BackCounter > 0) and (KnownPhysLen < Indent) do begin
dec(BackCounter);
Temp := GetLine(BackCounter);
if Temp <> '' then begin
Temp := copy(Temp, 1, GetIndentForLine(FCurrentEditor, Temp, False));
PhysLen := GetIndentForLine(FCurrentEditor, Temp, True);
if (PhysLen > KnownPhysLen) and (copy(temp, 1, length(BasedMix)) = BasedMix) then
begin
KnownMix := Temp;
KnownPhysLen := PhysLen;
IndentCharsFromLinePos := BackCounter + 1;
end;
end;
end;
Result := AdjustCharMix(Indent, KnownMix, '');
if not ModifyIndent then Indent := OrigIndent;
end;
procedure TSynBeautifier.ApplyIndent(LinePos: Integer;
Indent: Integer; RelativeToLinePos: Integer; IndentChars: String = '';
IndentCharsFromLinePos: Integer = 0);
var
CharMix: String;
i: Integer;
begin
if (LinePos < 1) or (LinePos > FCurrentEditor.Lines.Count) then
exit;
// calculate the final indent needed
if (RelativeToLinePos > 0) and (RelativeToLinePos <= FCurrentEditor.Lines.Count) then
Indent := Indent + GetIndentForLine(FCurrentEditor, GetLine(RelativeToLinePos-1), True);
if Indent< 0 then
Indent := 0;
// Calculate the charmix
CharMix := '';
if Indent > 0 then begin
if (IndentCharsFromLinePos > 0) and (IndentCharsFromLinePos <= FCurrentEditor.Lines.Count) then begin
CharMix := GetLine(IndentCharsFromLinePos-1);
i := GetIndentForLine(FCurrentEditor, CharMix, False);
CharMix := AdjustCharMix(Indent, copy(CharMix, 1, i), IndentChars);
end
else if IndentChars <> '' then begin
CharMix := AdjustCharMix(Indent, '', IndentChars);
end
else begin
i := LinePos;
CharMix := GetCharMix(LinePos, Indent, i);
end;
end;
{$IFDEF VerboseIndenter}
DebugLn(['TSynBeautifier.ApplyIndent IndentChars="',dbgstr(IndentChars),' Indent=',Indent]);
{$ENDIF}
i := GetIndentForLine(FCurrentEditor, GetLine(LinePos-1), False);
FCurrentLines.EditDelete(1, LinePos, i);
if (CharMix <> '') and not((FIndentType = sbitPositionCaret) and (GetLine(LinePos-1) = '')) then
FCurrentLines.EditInsert(1, LinePos, CharMix);
FLogicalIndentLen := length(CharMix);
{$IFDEF VerboseIndenter}
DebugLn(['TSynBeautifier.ApplyIndent Line="',dbgstr(FCurrentLines.ExpandedStrings[LinePos-1]),'"']);
{$ENDIF}
end;
function TSynBeautifier.GetIndentForLine(Editor: TSynEditBase; const Line: string; Physical: boolean): Integer;
var
p: PChar;
begin
p := PChar(Line);
if Assigned(p) then begin
Result := 0;
while p^ in [#1..#32] do begin
Inc(p);
Inc(Result);
end;
if Physical and (Result>0) then
Result := FCurrentLines.LogicalToPhysicalCol(Line, -1, Result+1)-1; // TODO, Need the real index of the line
end else
Result := 0;
end;
function TSynBeautifier.GetDesiredIndentForLine(Editor: TSynEditBase;
const Lines: TSynEditStrings; const ACaret: TSynEditCaret;
out ReplaceIndent: Boolean; out DesiredIndent: String): Integer;
var
BackCounter, PhysLen: Integer;
Temp: string;
FoundLine: LongInt;
begin
Result := 1;
FCurrentLines := Lines; // for GetCurrentIndent
BackCounter := ACaret.LinePos - 1;
if BackCounter > 0 then
repeat
Dec(BackCounter);
Temp := Lines[BackCounter];
Result := GetIndentForLine(Editor, Temp, True) + 1; // Physical
until (BackCounter = 0) or (Temp <> '');
FoundLine := BackCounter + 1;
ReplaceIndent := False;
//if assigned(FOnGetDesiredIndent) then
// FOnGetDesiredIndent(Editor, ACaret.LineBytePos, ACaret.LinePos, Result,
// FoundLine, ReplaceIndent);
//if Result < 0 then exit;
//if FoundLine > 0 then
// Temp := Lines[FoundLine-1]
//else
// FoundLine := BackCounter + 1;
Temp := copy(Temp, 1, GetIndentForLine(Editor, Temp, False));
case FIndentType of
sbitCopySpaceTab:
begin
DesiredIndent := copy(Temp, 1,
Lines.PhysicalToLogicalCol(Temp, FoundLine - 1, Result) - 1);
PhysLen := Lines.LogicalToPhysicalCol(Temp, ACaret.LinePos - 1, Length(Temp) + 1);
if PhysLen < Result then
DesiredIndent := DesiredIndent + StringOfChar(' ', Result - PhysLen);
end;
sbitConvertToTabSpace:
begin
dec(Result);
DesiredIndent := CreateTabSpaceMix(Result, False);
inc(Result);
end;
sbitConvertToTabOnly:
begin
dec(Result);
DesiredIndent := CreateTabSpaceMix(Result, True);
inc(Result);
end;
else
DesiredIndent := StringOfChar(' ', Result - 1);
end;
end;
function TSynBeautifier.GetDesiredIndentForLine(Editor: TSynEditBase;
const Lines: TSynEditStrings; const ACaret: TSynEditCaret): Integer;
var
Dummy: String;
Replace: Boolean;
begin
Result := GetDesiredIndentForLine(Editor, Lines, ACaret, Replace, Dummy);
end;
end.