151
155
bbtIfBegin, // child of bbtIfThen or bbtIfElse
153
157
bbtStatementRoundBracket,
154
bbtStatementEdgedBracket
158
bbtStatementEdgedBracket,
159
bbtProperty // global or class property
156
161
TFABBlockTypes = set of TFABBlockType;
159
164
bbtAllIdentifierSections = [bbtTypeSection,bbtConstSection,bbtVarSection,
160
bbtResourceStringSection,bbtLabelSection];
165
bbtResourceStringSection,bbtLabelSection,bbtClassSection];
161
166
bbtAllProcedures = [bbtProcedure,bbtFunction];
162
167
bbtAllCodeSections = [bbtInterface,bbtImplementation,bbtInitialization,
163
168
bbtFinalization];
164
169
bbtAllStatementParents = [bbtMainBegin,bbtFreeBegin,bbtProcedureBegin,
170
bbtRepeat,bbtWhileDo,bbtForDo,bbtWithDo,
166
171
bbtCaseColon,bbtCaseElse,
167
172
bbtTry,bbtFinally,bbtExcept,
168
173
bbtIfThen,bbtIfElse,bbtIfBegin];
170
175
bbtStatement,bbtStatementRoundBracket,bbtStatementEdgedBracket];
171
176
bbtAllBrackets = [bbtTypeRoundBracket,bbtTypeEdgedBracket,
172
177
bbtStatementRoundBracket,bbtStatementEdgedBracket];
173
bbtAllAutoEnd = [bbtStatement,bbtIf,bbtIfThen,bbtIfElse,bbtFor,bbtForDo,
174
bbtCaseLabel,bbtCaseColon];
178
bbtAllAutoEnd = [bbtStatement,bbtIf,bbtIfThen,bbtIfElse,bbtWhile,bbtWhileDo,
179
bbtFor,bbtForDo,bbtWith,bbtWithDo,bbtCaseLabel,bbtCaseColon];
175
180
bbtAllAlignToSibling = [bbtNone]+bbtAllStatements;
178
FABBlockTypeNames: array[TFABBlockType] of string = (
185
// identifier sections
190
'bbtResourceStringSection',
198
'bbtTypeRoundBracket',
199
'bbtTypeEdgedBracket',
204
'bbtProcedureParamList',
205
'bbtProcedureModifiers',
225
'bbtStatementRoundBracket',
226
'bbtStatementEdgedBracket'
230
183
TOnGetFABExamples = procedure(Sender: TObject; Code: TCodeBuffer;
231
184
Step: integer; // starting at 0
398
351
write FOnGetExamples;
399
352
property OnGetNestedComments: TOnGetFABNestedComments
400
353
read FOnGetNestedComments write FOnGetNestedComments;
401
property OnLoadFile: TOnGetFABFile read FOnLoadFile write FOnLoadFile;
354
property OnLoadFile: TOnLoadCTFile read FOnLoadFile write FOnLoadFile;
402
355
property UseDefaultIndentForTypes: TFABBlockTypes
403
356
read FUseDefaultIndentForTypes write FUseDefaultIndentForTypes;
359
function EnumToStr(BlockType: TFABBlockType): string;
406
360
function CompareFABPoliciesWithCode(Data1, Data2: Pointer): integer;
407
361
function CompareCodeWithFABPolicy(Key, Data: Pointer): integer;
365
function EnumToStr(BlockType: TFABBlockType): string;
367
WriteStr(Result, BlockType);
411
370
function CompareFABPoliciesWithCode(Data1, Data2: Pointer): integer;
413
372
Policies1: TFABPolicies absolute Data1;
452
411
ReAllocMem(Stack,SizeOf(TBlock)*Capacity);
454
413
{$IFDEF ShowCodeBeautifier}
455
DebugLn([GetIndentStr(Top*2),'TFABBlockStack.BeginBlock ',FABBlockTypeNames[Typ],' ',StartPos,' at ',PosToStr(StartPos)]);
414
DebugLn([GetIndentStr(Top*2),'TFABBlockStack.BeginBlock ',EnumToStr(Typ),' ',StartPos,' at ',PosToStr(StartPos)]);
457
416
Block:=@Stack[Top];
602
561
if (not InFirstLine) or LearnFromFirstLine then
603
562
Policies.AddIndent(Block^.Typ,Typ,AtomStart,Indent-BaseBlock^.Indent);
604
563
{$IFDEF ShowCodeBeautifierLearn}
605
DebugLn([GetIndentStr(Stack.Top*2),'nested indentation learned ',FABBlockTypeNames[Block^.Typ],'/',FABBlockTypeNames[Typ],': ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart),' Indent=',Indent,'-',BaseBlock^.Indent,'=',Indent-BaseBlock^.Indent]);
606
debugln([GetIndentStr(Stack.Top*2),' Src=',dbgstr(copy(Src,AtomStart-10,10)),'|',copy(Src,AtomStart,p-AtomStart),' BaseBlock=',FABBlockTypeNames[BaseBlock^.Typ]]);
564
DebugLn([GetIndentStr(Stack.Top*2),'nested indentation learned ',EnumToStr(Block^.Typ),'/',EnumToStr(Typ),': ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart),' Indent=',Indent,'-',BaseBlock^.Indent,'=',Indent-BaseBlock^.Indent]);
565
debugln([GetIndentStr(Stack.Top*2),' Src=',dbgstr(copy(Src,AtomStart-10,10)),'|',copy(Src,AtomStart,p-AtomStart),' BaseBlock=',EnumToStr(BaseBlock^.Typ)]);
607
566
if Typ=bbtCaseLabel then
608
567
Stack.WriteDebugReport(GetIndentStr(Stack.Top*2));
612
//if not FirstAtomOnNewLine then DebugLn([GetIndentStr(Stack.Top*2),'TRAILING BeginBlock ',FABBlockTypeNames[Typ],' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
571
//if not FirstAtomOnNewLine then DebugLn([GetIndentStr(Stack.Top*2),'TRAILING BeginBlock ',EnumToStr(Typ),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
613
572
Stack.BeginBlock(Typ,AtomStart,not FirstAtomOnNewLine,Indent);
614
573
{$IFDEF ShowCodeBeautifierParser}
615
DebugLn([GetIndentStr(Stack.Top*2),'BeginBlock ',FABBlockTypeNames[Typ],' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
574
DebugLn([GetIndentStr(Stack.Top*2),'BeginBlock ',EnumToStr(Typ),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
619
578
procedure EndBlock;
621
580
{$IFDEF ShowCodeBeautifierParser}
622
DebugLn([GetIndentStr(Stack.Top*2),'EndBlock ',FABBlockTypeNames[Stack.TopType],' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
581
DebugLn([GetIndentStr(Stack.Top*2),'EndBlock ',EnumToStr(Stack.TopType),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
624
583
AtomEndedBlock:=true;
625
584
Stack.EndBlock(p);
684
643
procedure StartProcedure(Typ: TFABBlockType);
686
if Stack.TopType<>bbtDefinition then
645
if not (Stack.TopType in [bbtDefinition,bbtClassSection]) then
687
646
EndIdentifierSectionAndProc;
688
if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone,bbtDefinition])
647
if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone,bbtDefinition,bbtClassSection])
691
650
BeginBlock(bbtProcedureHead);
654
procedure StartProperty;
656
if Stack.TopType in [bbtNone, bbtClassSection] then
657
BeginBlock(bbtProperty);
695
660
procedure StartClassSection;
697
662
if (LastAtomStart>0) and (CompareIdentifiers('STRICT',@Src[LastAtomStart])=0)
1143
1117
if CompareIdentifiers('VAR',r)=0 then begin
1144
1118
StartIdentifierSection(bbtVarSection);
1121
case UpChars[r[1]] of
1123
if CompareIdentifiers('WHILE',r)=0 then begin
1124
if Stack.TopType in bbtAllStatements then
1125
BeginBlock(bbtWhile)
1128
if CompareIdentifiers('WITH',r)=0 then begin
1129
if Stack.TopType in bbtAllStatements then
1148
1135
// common syntax error: unclosed bracket => ignore it
1149
1136
while Stack.TopType in [bbtStatementRoundBracket,bbtStatementEdgedBracket] do
1151
1138
case Stack.TopType of
1152
bbtUsesSection,bbtDefinition:
1139
bbtUsesSection,bbtDefinition,bbtProperty:
1154
1141
bbtIfThen,bbtIfElse,bbtStatement,bbtFor,bbtForDo,bbtCaseColon,bbtCaseLabel:
1263
1246
if (Block^.InnerIdent>=0) then begin
1264
1247
Policies.AddIndent(Block^.Typ,bbtNone,AtomStart,Block^.InnerIdent);
1265
1248
{$IFDEF ShowCodeBeautifierLearn}
1266
DebugLn([GetIndentStr(Stack.Top*2),'Indentation learned for bbtNone: ',FABBlockTypeNames[Block^.Typ],' Indent=',Block^.InnerIdent,' at ',PosToStr(p)]);
1249
DebugLn([GetIndentStr(Stack.Top*2),'Indentation learned for bbtNone: ',EnumToStr(Block^.Typ),' Indent=',Block^.InnerIdent,' at ',PosToStr(p)]);
1692
1675
if Stack<>nil then begin
1693
1676
for i:=0 to Stack.Top do begin
1694
1677
Block:=@Stack.Stack[i];
1695
DebugLn([GetIndentStr(i*2),' : Typ=',FABBlockTypeNames[Block^.Typ],' StartPos=',Block^.StartPos,' InnerIdent=',Block^.InnerIdent,' InnerStartPos=',Block^.InnerStartPos]);
1678
DebugLn([GetIndentStr(i*2),' : Typ=',EnumToStr(Block^.Typ),' StartPos=',Block^.StartPos,' InnerIdent=',Block^.InnerIdent,' InnerStartPos=',Block^.InnerStartPos]);
1743
1726
// policy found
1744
1727
{$IFDEF VerboseIndenter}
1745
1728
if SubTypeValid then
1746
DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' BlockIndent=',BlockIndent])
1729
DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' BlockIndent=',BlockIndent])
1748
DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',FABBlockTypeNames[Block.Typ],' BlockIndent=',BlockIndent]);
1731
DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',EnumToStr(Block.Typ),' BlockIndent=',BlockIndent]);
1749
1732
//Policies.WriteDebugReport;
1751
1734
Indent.Indent:=GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)
1847
1830
// use indent of block start
1848
1831
Block:=Stack.Stack[StackIndex+1];
1849
1832
{$IFDEF VerboseIndenter}
1850
DebugLn(['TFullyAutomaticBeautifier.GetIndent next token close block: ',FABBlockTypeNames[Stack.TopType],' Block=',dbgstr(copy(Source,Block.StartPos,20))]);
1833
DebugLn(['TFullyAutomaticBeautifier.GetIndent next token close block: ',EnumToStr(Stack.TopType),' Block=',dbgstr(copy(Source,Block.StartPos,20))]);
1852
1835
Indent.Indent:=GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth);
1853
1836
Indent.IndentValid:=true;
1897
1880
{$IFDEF VerboseIndenter}
1898
DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' indent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1881
DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' indent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1900
1883
if Policies<>nil then begin
1901
1884
// check source in front for good match
1918
1901
// parse examples for good match
1919
1902
ExamplePolicies:=FindPolicyInExamples(nil,Block.Typ,SubType,true,false);
1920
1903
{$IFDEF VerboseIndenter}
1921
DebugLn(['TFullyAutomaticBeautifier.GetIndent searched examples for exact match: context=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1904
DebugLn(['TFullyAutomaticBeautifier.GetIndent searched examples for exact match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1923
1906
if CheckPolicies(ExamplePolicies,Result,false) then exit;
1925
1908
if Policies<>nil then begin
1926
1909
// check current source for any match
1927
1910
{$IFDEF VerboseIndenter}
1928
DebugLn(['TFullyAutomaticBeautifier.GetIndent check current source for any match: context=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1911
DebugLn(['TFullyAutomaticBeautifier.GetIndent check current source for any match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1930
1913
if CheckPolicies(Policies,Result,true) then exit;
1933
1916
// parse examples for any match
1934
1917
ExamplePolicies:=FindPolicyInExamples(nil,Block.Typ,SubType,true,true);
1935
1918
{$IFDEF VerboseIndenter}
1936
DebugLn(['TFullyAutomaticBeautifier.GetIndent searching examples for any match: context=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1919
DebugLn(['TFullyAutomaticBeautifier.GetIndent searching examples for any match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1938
1921
if CheckPolicies(ExamplePolicies,Result,true) then exit;
1947
1930
{$IFDEF VerboseIndenter}
1948
DebugLn(['TFullyAutomaticBeautifier.GetIndent no example found : context=',FABBlockTypeNames[Block.Typ],'/',FABBlockTypeNames[SubType],' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1931
DebugLn(['TFullyAutomaticBeautifier.GetIndent no example found : context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
1950
1933
if SubTypeValid then
1951
1934
GetDefaultIndentPolicy(Block.Typ,SubType,Indent)
2088
2071
Item^.Block:=Stack.Stack[StackIndex];
2089
2072
{$IFDEF VerboseIndenter}
2090
DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',FABBlockTypeNames[Item^.Block.Typ],'/',FABBlockTypeNames[Item^.SubType],' indent=',GetLineIndentWithTabs(Source,Item^.Block.StartPos,DefaultTabWidth)]);
2073
DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',EnumToStr(Item^.Block.Typ),'/',EnumToStr(Item^.SubType),' indent=',GetLineIndentWithTabs(Source,Item^.Block.StartPos,DefaultTabWidth)]);
2092
2075
if CheckPolicies(Policies,Item) then exit(true);
2302
2285
Ind^.SrcPos:=SrcPos;
2304
2287
{$IFDEF ShowCodeBeautifierLearn}
2305
DebugLn(['TFABPolicies.AddIndent New SubTyp ',FABBlockTypeNames[Typ],'-',FABBlockTypeNames[SubType],': indent=',Indent,' ',CodePosToStr(SrcPos)]);
2288
DebugLn(['TFABPolicies.AddIndent New SubTyp ',EnumToStr(Typ),'-',EnumToStr(SubType),': indent=',Indent,' ',CodePosToStr(SrcPos)]);
2306
2289
ConsistencyCheck;
2310
2293
if Ind^.Indent<>Indent then begin
2311
2294
Ind^.Indent:=Indent;
2312
2295
{$IFDEF ShowCodeBeautifierLearn}
2313
DebugLn(['TFABPolicies.AddIndent Changed SubTyp ',FABBlockTypeNames[Typ],'-',FABBlockTypeNames[SubType],': indent=',Indent,' ',CodePosToStr(SrcPos)]);
2296
DebugLn(['TFABPolicies.AddIndent Changed SubTyp ',EnumToStr(Typ),'-',EnumToStr(SubType),': indent=',Indent,' ',CodePosToStr(SrcPos)]);
2324
2307
for i:=0 to IndentationCount-1 do begin
2325
2308
if (Indentations[i].Typ<>Typ) or (Indentations[i].Indent<0) then continue;
2326
2309
{$IFDEF VerboseIndenter}
2327
debugln(['TFABPolicies.GetSmallestIndent ',FABBlockTypeNames[Indentations[i].Typ],'/',FABBlockTypeNames[Indentations[i].SubTyp],' Indent=',Indentations[i].Indent
2310
debugln(['TFABPolicies.GetSmallestIndent ',EnumToStr(Indentations[i].Typ),'/',EnumToStr(Indentations[i].SubTyp),' Indent=',Indentations[i].Indent
2328
2311
{$IFDEF StoreLearnedPositions}
2329
2312
,' SrcPos=',CodePosToStr(Indentations[i].SrcPos)
2345
2328
if FindIndentation(Typ,SubType,i) then begin
2346
2329
Result:=Indentations[i].Indent;
2347
2330
{$IFDEF VerboseIndenter}
2348
debugln(['TFABPolicies.GetIndent ',FABBlockTypeNames[Typ],'/',FABBlockTypeNames[SubType],' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
2331
debugln(['TFABPolicies.GetIndent ',EnumToStr(Typ),'/',EnumToStr(SubType),' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
2350
2333
end else if UseNoneIfNotFound and FindIndentation(Typ,bbtNone,i) then begin
2351
2334
Result:=Indentations[i].Indent;
2352
2335
{$IFDEF VerboseIndenter}
2353
debugln(['TFABPolicies.GetIndent ',FABBlockTypeNames[Typ],'/',FABBlockTypeNames[bbtNone],' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
2336
debugln(['TFABPolicies.GetIndent ',EnumToStr(Typ),'/',EnumToStr(bbtNone),' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
2355
2338
end else if UseSmallestIfNotFound then
2356
2339
Result:=GetSmallestIndent(Typ)
2416
2399
debugln(['TFABPolicies.WriteDebugReport ']);
2417
2400
for i:=0 to IndentationCount-1 do begin
2418
2401
Ind:=@Indentations[i];
2419
debugln([' ',i,'/',IndentationCount,' ',FABBlockTypeNames[Ind^.Typ],'=',ord(Ind^.Typ),' ',FABBlockTypeNames[Ind^.SubTyp],'=',ord(Ind^.SubTyp),' Indent=',Ind^.Indent]);
2402
debugln([' ',i,'/',IndentationCount,' ',EnumToStr(Ind^.Typ),'=',ord(Ind^.Typ),' ',EnumToStr(Ind^.SubTyp),'=',ord(Ind^.SubTyp),' Indent=',Ind^.Indent]);