File: codebeautifier.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
links: PTS, VCS
area: main
in suites: buster
size: 214,460 kB
sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (2454 lines) | stat: -rw-r--r-- 77,542 bytes
parent folder | download | duplicates (5)
{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner
}
(*
  Abstract:
    Functions to beautify code.
    Goals:
      - fully automatic (instead of fixed rules mimic the indentation of example code(s))
      - when target source is within example source use the nearest match.
      - Customizable (e.g. use boolean: check the global example code, boolean)
      - Beautification of whole sources. For example a unit, or several
        sources.
      - Beautification of parts of sources. For example selections.
      - Beautification of insertion source (Paste). For example beautifying
        code, that will be inserted in another source.
      - Find a nice indendation for empty line (e.g. after pressing return)
        - Inside comments: use indentation of last non empty line
      - Working with syntax errors. The beautification will try its best to
        work, even if the source contains errors.
      - Comments are special statements.

  Line break:
   1. indent to the smallest indent
       For example, when there is always an indent after 'try':
         try|
           |
       For example when sometimes no indent is after 'then':
         if expr then|
         |
   2.  unindent when block was closed
       For example after closing blocks with a semicolon:
         if expr then
           if expr then
             doit;|
         |
       Closing the corresponding block, not all blocks:
         if expr then
           if expr then begin|
           |end
   3.  optional 'UseLineStart': when next token in line closes block:
         repeat|
         |until
       When 'until' is not current line, ignore it:
         repeat|
           |
         until
   4. When unsure, tell that and use identation of last non empty line
   5. Nested blocks do not need to be indented monoton:
        if expr
            or expr then
          statement;
        begin
        //comment
          statement;
        //comment
          statement;
      {$IFDEF expr}
          statement;
      {$ENDIF}
        end;

  Examples for beautification styles: see examples/scanexamples/indentation.pas

  ToDo:
    * LineBreak:
      - Optional: indent last line after pressing return key:
          if true then
          exit;|
          |
    * long lines
       DoSomething(Param1,
                   Param2);
*)
unit CodeBeautifier;

{$mode objfpc}{$H+}

interface

{ $DEFINE ShowCodeBeautifier}
{ $DEFINE ShowCodeBeautifierParser}
{ $DEFINE ShowCodeBeautifierLearn}
{ $DEFINE VerboseIndenter}

{$IFDEF ShowCodeBeautifierParser}
{$DEFINE ShowCodeBeautifierLearn}
{$ENDIF}
{$IF defined(VerboseIndenter) or defined(ShowCodeBeautifierLearn)}
{$DEFINE StoreLearnedPositions}
{$ENDIF}

uses
  Classes, SysUtils, Laz_AVL_Tree,
  // Codetools
  FileProcs, KeywordFuncLists, CodeCache, BasicCodeTools,
  // LazUtils
  LazUtilities;
  
type
  TWordPolicy = (
    wpNone,
    wpLowerCase,
    wpUpperCase,
    wpLowerCaseFirstLetterUp
    );

  TFABBlockType = (
    bbtNone, // all else (comments, enums, continued lines, ...)
    // code sections
    bbtInterface,
    bbtImplementation,
    bbtInitialization,
    bbtFinalization,
    // identifier sections
    bbtUsesSection,
    bbtTypeSection,
    bbtConstSection,
    bbtVarSection,
    bbtResourceStringSection,
    bbtLabelSection,
    bbtDefinition,  // child of bbtTypeSection,bbtConstSection,bbtVarSection,bbtResourceStringSection,bbtLabelSection
    // type blocks
    bbtRecord,
    bbtClass,        // class, object, objcclass, objccategory
    bbtClassInterface, // interface, dispinterface, objcprotocol
    bbtClassSection, // public, private, protected, published
    bbtTypeRoundBracket,
    bbtTypeEdgedBracket,
    // statement blocks
    bbtProcedure, // procedure, constructor, destructor
    bbtFunction,  // function, operator
    bbtProcedureHead,      // child of bbtProcedure or bbtFunction
    bbtProcedureParamList, // child of bbtProcedureHead
    bbtProcedureModifiers, // child of bbtProcedureHead
    bbtProcedureBegin,     // child of bbtProcedure or bbtFunction
    bbtMainBegin,
    bbtFreeBegin, // a normal begin
    bbtRepeat,
    bbtWhile,
    bbtWhileDo,   // child of bbtWhile
    bbtFor,
    bbtForDo,     // child of bbtFor
    bbtWith,
    bbtWithDo,    // child of bbtWith
    bbtCase,
    bbtCaseOf,    // child of bbtCase
    bbtCaseLabel, // child of bbtCaseOf
    bbtCaseColon, // child of bbtCaseLabel
    bbtCaseElse,  // child of bbtCase
    bbtTry,
    bbtFinally,   // sibling of bbtTry
    bbtExcept,    // sibling of bbtTry
    bbtIf,
    bbtIfThen,    // child of bbtIf
    bbtIfElse,    // child of bbtIf
    bbtIfBegin,   // child of bbtIfThen or bbtIfElse
    bbtStatement,
    bbtStatementRoundBracket,
    bbtStatementEdgedBracket,
    bbtProperty   // global or class property
    );
  TFABBlockTypes = set of TFABBlockType;

const
  bbtAllIdentifierSections = [bbtTypeSection,bbtConstSection,bbtVarSection,
       bbtResourceStringSection,bbtLabelSection,bbtClassSection];
  bbtAllProcedures = [bbtProcedure,bbtFunction];
  bbtAllCodeSections = [bbtInterface,bbtImplementation,bbtInitialization,
                        bbtFinalization];
  bbtAllStatementParents = [bbtMainBegin,bbtFreeBegin,bbtProcedureBegin,
                        bbtRepeat,bbtWhileDo,bbtForDo,bbtWithDo,
                        bbtCaseColon,bbtCaseElse,
                        bbtTry,bbtFinally,bbtExcept,
                        bbtIfThen,bbtIfElse,bbtIfBegin];
  bbtAllStatements = bbtAllStatementParents+[
                      bbtStatement,bbtStatementRoundBracket,bbtStatementEdgedBracket];
  bbtAllBrackets = [bbtTypeRoundBracket,bbtTypeEdgedBracket,
                    bbtStatementRoundBracket,bbtStatementEdgedBracket];
  bbtAllAutoEnd = [bbtStatement,bbtIf,bbtIfThen,bbtIfElse,bbtWhile,bbtWhileDo,
                  bbtFor,bbtForDo,bbtWith,bbtWithDo,bbtCaseLabel,bbtCaseColon];
  bbtAllAlignToSibling = [bbtNone]+bbtAllStatements;

type
  TOnGetFABExamples = procedure(Sender: TObject; Code: TCodeBuffer;
                                Step: integer; // starting at 0
                                var CodeBuffers: TFPList; // stopping when CodeBuffers=nil
                                var ExpandedFilenames: TStrings  // and ExpandedFilenames=nil
                                ) of object;
  TOnGetFABNestedComments = procedure(Sender: TObject; Code: TCodeBuffer;
                                      out NestedComments: boolean) of object;
  TOnLoadCTFile = procedure(Sender: TObject; const ExpandedFilename: string;
                            out Code: TCodeBuffer; var Abort: boolean) of object;

  TFABIndentationPolicy = record
    Indent: integer;
    IndentValid: boolean;
  end;

  TFABFoundIndentationPolicy = packed record
    Typ, SubTyp: TFABBlockType;
    Indent: integer;
    {$IFDEF StoreLearnedPositions}
    SrcPos: integer;
    {$ENDIF}
  end;
  PFABFoundIndentationPolicy = ^TFABFoundIndentationPolicy;

  { TFABPolicies }

  TFABPolicies = class
  private
    function FindIndentation(Typ, SubType: TFABBlockType;
                             out InsertPos: integer): boolean;
  public
    IndentationCount, IndentationCapacity: integer;
    Indentations: PFABFoundIndentationPolicy; // sorted ascending
    Code: TCodeBuffer;
    CodeChangeStep: integer;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure AddIndent(Typ, SubType: TFABBlockType; SrcPos, Indent: integer);
    function GetSmallestIndent(Typ: TFABBlockType): integer;// -1 if none found
    function GetIndent(Typ, SubType: TFABBlockType;
                       UseNoneIfNotFound,
                       UseSmallestIfNotFound: boolean): integer;// -1 if none found
    function CodePosToStr(p: integer): string;
    procedure ConsistencyCheck;
    procedure WriteDebugReport;
  end;

type
  TBlock = record
    Typ: TFABBlockType;
    StartPos: integer;
    Indent: integer;
    Trailing: boolean; // true = StartPos is not first atom in line
    InnerStartPos: integer;
    InnerIdent: integer; // valid if >=0
  end;
  PBlock = ^TBlock;

const
  CleanBlock: TBlock = (
    Typ: bbtNone;
    StartPos: -1;
    Indent: -1;
    Trailing: false;
    InnerStartPos: -1;
    InnerIdent: -1
  );

type
  TFABPositionIndent = record
    CleanPos: integer;
    Indent: TFABIndentationPolicy;
    Block: TBlock;
    SubType: TFABBlockType;
    SubTypeValid: boolean;
  end;
  PFABPositionIndent = ^TFABPositionIndent;

  { TFABPositionIndents }

  TFABPositionIndents = class
  private
    FCount: integer;
    procedure SetCount(const AValue: integer);
  public
    Items: PFABPositionIndent;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    property Count: integer read FCount write SetCount;
  end;

  { TFABBlockStack }

  TFABBlockStack = class
  public
    Stack: PBlock;
    Capacity: integer;
    Top: integer; // -1 = empty, 0 = 1 item
    TopType: TFABBlockType;
    LastBlockClosed: TBlock;
    LastBlockClosedAt: integer;
    constructor Create;
    destructor Destroy; override;
    procedure BeginBlock(Typ: TFABBlockType; StartPos: integer;
                         Trailing: boolean; Indent: integer);
    procedure EndBlock(EndPos: integer);
    function TopMostIndexOf(Typ: TFABBlockType): integer;
    function EndTopMostBlock(Typ: TFABBlockType; EndPos: integer): boolean;
    {$IFDEF ShowCodeBeautifier}
    Src: string;
    function PosToStr(p: integer): string;
    {$ENDIF}
    procedure WriteDebugReport(Prefix: string);
  end;

  { TFullyAutomaticBeautifier }

  TFullyAutomaticBeautifier = class
  private
    FOnGetExamples: TOnGetFABExamples;
    FCodePolicies: TAVLTree;// tree of TFABPolicies sorted for Code
    FOnGetNestedComments: TOnGetFABNestedComments;
    FOnLoadFile: TOnLoadCTFile;
    FUseDefaultIndentForTypes: TFABBlockTypes;
    procedure ParseSource(const Src: string; StartPos, EndPos: integer;
      NestedComments: boolean;
      Stack: TFABBlockStack; Policies: TFABPolicies;
      out LastAtomStart, LastAtomEnd: integer; // set if LastAtomStart<EndPos<LastAtomEnd
      LearnFromFirstLine: boolean = true
      );
    procedure ParseSource(const Src: string; StartPos, EndPos: integer;
                          NestedComments: boolean;
                          Stack: TFABBlockStack; Policies: TFABPolicies;
                          LearnFromFirstLine: boolean = true);
    function FindPolicyInExamples(StartCode: TCodeBuffer;
                                  Typ, SubTyp: TFABBlockType;
                                  UseNoneIfNotFound,
                                  UseSmallestIfNotFound: boolean): TFABPolicies;
    function GetNestedCommentsForCode(Code: TCodeBuffer): boolean;
    function AdjustByNextAtom(const Source: string;
                             CleanPos: integer; NestedComments: boolean;
                             Stack: TFABBlockStack;
                             out TopType: TFABBlockType;
                             out TopTypeValid: boolean): integer;
    procedure WriteDebugReport(Msg: string; Stack: TFABBlockStack);
  public
    DefaultTabWidth: integer;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function GetIndent(const Source: string; CleanPos: integer;
                       NewNestedComments: boolean; UseLineStart: boolean;
                       out Indent: TFABIndentationPolicy;
                       ContextLearn: boolean = true; // true = learn policies from Source
                       const InsertText: string = ''
                       ): boolean;
    function GetIndents(const Source: string; Positions: TFABPositionIndents;
                        NewNestedComments: boolean; UseLineStart: boolean;
                        ContextLearn: boolean = true // true = learn policies from Source
                        ): boolean;
    procedure GetDefaultSrcIndent(const Source: string; CleanPos: integer;
                               {%H-}NewNestedComments: boolean;
                               out Indent: TFABIndentationPolicy);
    procedure GetDefaultIndentPolicy(Typ, SubTyp: TFABBlockType;
                                  out Indent: TFABIndentationPolicy);
    property OnGetExamples: TOnGetFABExamples read FOnGetExamples
                                              write FOnGetExamples;
    property OnGetNestedComments: TOnGetFABNestedComments
                           read FOnGetNestedComments write FOnGetNestedComments;
    property OnLoadFile: TOnLoadCTFile read FOnLoadFile write FOnLoadFile;
    property UseDefaultIndentForTypes: TFABBlockTypes
                 read FUseDefaultIndentForTypes write FUseDefaultIndentForTypes;
  end;

function EnumToStr(BlockType: TFABBlockType): string;
function CompareFABPoliciesWithCode(Data1, Data2: Pointer): integer;
function CompareCodeWithFABPolicy(Key, Data: Pointer): integer;

implementation

function EnumToStr(BlockType: TFABBlockType): string;
begin
  WriteStr(Result, BlockType);
end;

function CompareFABPoliciesWithCode(Data1, Data2: Pointer): integer;
var
  Policies1: TFABPolicies absolute Data1;
  Policies2: TFABPolicies absolute Data2;
begin
  Result:=ComparePointers(Policies1.Code,Policies2.Code);
end;

function CompareCodeWithFABPolicy(Key, Data: Pointer): integer;
var
  Policies: TFABPolicies absolute Data;
begin
  Result:=ComparePointers(Key,Policies.Code);
end;

{ TFABBlockStack }

constructor TFABBlockStack.Create;
begin
  Top:=-1;
end;

destructor TFABBlockStack.Destroy;
begin
  ReAllocMem(Stack,0);
  Capacity:=0;
  Top:=-1;
  inherited Destroy;
end;

procedure TFABBlockStack.BeginBlock(Typ: TFABBlockType; StartPos: integer;
  Trailing: boolean; Indent: integer);
var
  Block: PBlock;
begin
  inc(Top);
  if Top>=Capacity then begin
    if Capacity=0 then
      Capacity:=16
    else
      Capacity:=Capacity*2;
    ReAllocMem(Stack,SizeOf(TBlock)*Capacity);
  end;
  {$IFDEF ShowCodeBeautifier}
  DebugLn([GetIndentStr(Top*2),'TFABBlockStack.BeginBlock ',EnumToStr(Typ),' ',StartPos,' at ',PosToStr(StartPos)]);
  {$ENDIF}
  Block:=@Stack[Top];
  Block^.Typ:=Typ;
  Block^.StartPos:=StartPos;
  Block^.Indent:=Indent;
  Block^.Trailing:=Trailing;
  Block^.InnerIdent:=-1;
  Block^.InnerStartPos:=-1;
  TopType:=Typ;
  LastBlockClosed.Typ:=bbtNone;
  LastBlockClosed.StartPos:=0;
  LastBlockClosedAt:=0;
end;

procedure TFABBlockStack.EndBlock(EndPos: integer);
begin
  {$IFDEF ShowCodeBeautifier}
  DebugLn([GetIndentStr(Top*2),'TFABBlockStack.EndBlock ',EnumToStr(TopType)]);
  {$ENDIF}
  if Top<0 then
    exit;
  if Top>=0 then begin
    LastBlockClosed:=Stack[Top];
    LastBlockClosedAt:=EndPos;
  end;
  dec(Top);
  if Top>=0 then
    TopType:=Stack[Top].Typ
  else
    TopType:=bbtNone;
end;

function TFABBlockStack.TopMostIndexOf(Typ: TFABBlockType): integer;
begin
  Result:=Top;
  while (Result>=0) and (Stack[Result].Typ<>Typ) do dec(Result);
end;

function TFABBlockStack.EndTopMostBlock(Typ: TFABBlockType;
  EndPos: integer): boolean;
// check if there is this type on the stack and if yes, end it
var
  i: LongInt;
begin
  i:=TopMostIndexOf(Typ);
  if i<0 then exit(false);
  Result:=true;
  while Top>=i do EndBlock(EndPos);
end;

procedure TFABBlockStack.WriteDebugReport(Prefix: string);
var
  i: Integer;
begin
  for i:=0 to Top do begin
    debugln([Prefix+GetIndentStr(i*2),EnumToStr(Stack[i].Typ),
      ' StartPos=',Stack[i].StartPos,
      ' Indent=',Stack[i].Indent,
      ' Trailing=',Stack[i].Trailing,
      ' Indent=',Stack[i].Indent,
      ' InnerStartPos=',Stack[i].InnerStartPos,
      ' InnerIdent=',Stack[i].InnerIdent,
      '']);
  end;
end;

{$IFDEF ShowCodeBeautifier}
function TFABBlockStack.PosToStr(p: integer): string;
var
  X: integer;
  Y: LongInt;
begin
  Result:='';
  if Src='' then exit;
  Y:=LineEndCount(Src,1,p,X)+1;
  Result:='y='+dbgs(Y)+',x='+dbgs(X+1);
end;
{$ENDIF}

{ TFullyAutomaticBeautifier }

procedure TFullyAutomaticBeautifier.ParseSource(const Src: string;
  StartPos, EndPos: integer; NestedComments: boolean; Stack: TFABBlockStack;
  Policies: TFABPolicies; out LastAtomStart, LastAtomEnd: integer;
  LearnFromFirstLine: boolean);
var
  p: Integer;
  AtomStart: integer;
  AtomStartedBlock, AtomEndedBlock: boolean;
  FirstAtomOnNewLine: Boolean;
  InFirstLine: boolean;

  {$IFDEF ShowCodeBeautifierLearn}
  function PosToStr(p: integer): string;
  var
    X: integer;
    Y: LongInt;
  begin
    Y:=LineEndCount(Src,1,p,X)+1;
    Result:='Line='+dbgs(Y)+' Col='+dbgs(X+1);
  end;
  {$ENDIF}

  procedure UpdateBlockInnerIndent;
  var
    Block: PBlock;
    BlockStartPos: LongInt;
    i: LongInt;
  begin
    i:=Stack.Top;
    Block:=@Stack.Stack[i];
    if Block^.InnerIdent<0 then begin
      while (i>0) and Stack.Stack[i].Trailing do dec(i);
      BlockStartPos:=Stack.Stack[i].StartPos;
      if not PositionsInSameLine(Src,BlockStartPos,Block^.InnerStartPos) then
        Block^.InnerIdent:=
            GetLineIndentWithTabs(Src,Block^.InnerStartPos,DefaultTabWidth)
                  -GetLineIndentWithTabs(Src,BlockStartPos,DefaultTabWidth);
    end;
  end;

  procedure BeginBlock(Typ: TFABBlockType);
  var
    Block: PBlock;
    Indent: Integer;
    i: LongInt;
    BaseBlock: PBlock;
  begin
    AtomStartedBlock:=true;
    i:=Stack.Top;
    Indent:=-1;
    if (Policies<>nil) and (i>=0) and FirstAtomOnNewLine then begin
      Block:=@Stack.Stack[i];
      { For example:
          if expr
              or expr then
            Code;
         Learn that ifThen/Statement is indented by two
         The indentation is taken from the IF, because the THEN is trailing.
      }
      while (i>0) and Stack.Stack[i].Trailing do dec(i);
      BaseBlock:=@Stack.Stack[i];
      if BaseBlock^.Indent<0 then
        BaseBlock^.Indent:=GetLineIndentWithTabs(Src,BaseBlock^.StartPos,DefaultTabWidth);
      Indent:=GetLineIndentWithTabs(Src,AtomStart,DefaultTabWidth);
      if BaseBlock^.Indent<=Indent then begin
        if (not InFirstLine) or LearnFromFirstLine then
          Policies.AddIndent(Block^.Typ,Typ,AtomStart,Indent-BaseBlock^.Indent);
        {$IFDEF ShowCodeBeautifierLearn}
        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]);
        debugln([GetIndentStr(Stack.Top*2),'  Src=',dbgstr(copy(Src,AtomStart-10,10)),'|',copy(Src,AtomStart,p-AtomStart),' BaseBlock=',EnumToStr(BaseBlock^.Typ)]);
        if Typ=bbtCaseLabel then
          Stack.WriteDebugReport(GetIndentStr(Stack.Top*2));
        {$ENDIF}
      end;
    end;
    //if not FirstAtomOnNewLine then DebugLn([GetIndentStr(Stack.Top*2),'TRAILING BeginBlock ',EnumToStr(Typ),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
    Stack.BeginBlock(Typ,AtomStart,not FirstAtomOnNewLine,Indent);
    {$IFDEF ShowCodeBeautifierParser}
    DebugLn([GetIndentStr(Stack.Top*2),'BeginBlock ',EnumToStr(Typ),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
    {$ENDIF}
  end;

  procedure EndBlock;
  begin
    {$IFDEF ShowCodeBeautifierParser}
    DebugLn([GetIndentStr(Stack.Top*2),'EndBlock ',EnumToStr(Stack.TopType),' ',GetAtomString(@Src[AtomStart],NestedComments),' at ',PosToStr(AtomStart)]);
    {$ENDIF}
    AtomEndedBlock:=true;
    Stack.EndBlock(p);
  end;

  procedure EndTopMostBlock(Typ: TFABBlockType);
  var
    i: LongInt;
  begin
    i:=Stack.TopMostIndexOf(Typ);
    if i<0 then exit;
    while Stack.Top>=i do EndBlock;
  end;

  procedure BeginClass;
  begin
    BeginBlock(bbtClass);
    // the first section is created automatically
    BeginBlock(bbtClassSection);
  end;

  procedure EndStatements;
  begin
    while Stack.TopType in bbtAllStatements do EndBlock;
  end;

  function IsProcedureImplementation: boolean;
  // check if current bbtProcedure/bbtFunction expects a begin..end
  begin
    Result:=(Stack.Top=0)
      or (Stack.Stack[Stack.Top-1].Typ in (bbtAllProcedures+[bbtImplementation]));
  end;

  procedure EndIdentifierSectionAndProc;
  begin
    EndStatements;  // fix dangling statements
    if Stack.TopType=bbtProcedureModifiers then
      EndBlock;
    if Stack.TopType=bbtProcedureHead then
      EndBlock;
    if Stack.TopType in bbtAllProcedures then begin
      if IsProcedureImplementation then begin
        // procedure with begin..end
      end else begin
        // procedure without begin..end
        EndBlock;
      end;
    end;
    if Stack.TopType=bbtDefinition then
      EndBlock;
    if Stack.TopType in bbtAllIdentifierSections then
      EndBlock;
  end;

  procedure StartIdentifierSection(Section: TFABBlockType);
  begin
    EndIdentifierSectionAndProc;
    if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone]) then
      BeginBlock(Section);
  end;

  procedure StartProcedure(Typ: TFABBlockType);
  begin
    if not (Stack.TopType in [bbtDefinition,bbtClassSection]) then
      EndIdentifierSectionAndProc;
    if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone,bbtDefinition,bbtClassSection])
    then begin
      BeginBlock(Typ);
      BeginBlock(bbtProcedureHead);
    end;
  end;

  procedure StartProperty;
  begin
    if Stack.TopType in [bbtNone, bbtClassSection] then
      BeginBlock(bbtProperty);
  end;

  procedure StartClassSection;
  begin
    if (LastAtomStart>0) and (CompareIdentifiers('STRICT',@Src[LastAtomStart])=0)
    then begin
      exit;
    end;
    if Stack.TopType=bbtClassSection then
      EndBlock;
    if Stack.TopType=bbtClass then
      BeginBlock(bbtClassSection);
  end;

  procedure EndProcedureHead;
  begin
    if Stack.TopType=bbtProcedureModifiers then
      EndBlock;
    if Stack.TopType=bbtProcedureHead then
      EndBlock;
    if (Stack.TopType in bbtAllProcedures) and (not IsProcedureImplementation)
    then begin
      EndBlock;
      if Stack.TopType=bbtDefinition then
        EndBlock;
    end;
  end;

  function CheckProcedureModifiers: boolean;
  var
    NextAtomStart: LongInt;
    NextAtomEnd: LongInt;
    i: LongInt;
    ParentTyp: TFABBlockType;
  begin
    Result:=false;
    i:=Stack.Top;
    if Stack.TopType=bbtProcedureModifiers then
      dec(i);
    if (i<0) then exit;
    if Stack.Stack[i].Typ<>bbtProcedureHead then exit;
    dec(i);
    if i<0 then exit;
    if not (Stack.Stack[i].Typ in bbtAllProcedures) then exit;
    dec(i);
    if i<0 then exit;
    if Stack.Stack[i].Typ=bbtDefinition then begin
      dec(i);
      if i<0 then exit;
    end;
    // cursor is on the semicolon, peek next atom
    NextAtomStart:=AtomStart;
    NextAtomEnd:=p;
    ReadRawNextPascalAtom(Src,NextAtomEnd,NextAtomStart,NestedComments);
    if NextAtomStart>length(Src) then exit;
    ParentTyp:=Stack.Stack[i].Typ;
    case ParentTyp of
    bbtClassSection:
      if not IsKeyWordMethodSpecifier.DoItCaseInsensitive(@Src[NextAtomStart])
      then exit;
    bbtProcedure,bbtFunction,bbtImplementation,bbtInterface:
      if not IsKeyWordProcedureSpecifier.DoItCaseInsensitive(@Src[NextAtomStart])
      then exit;
    bbtTypeSection:
      if not IsKeyWordProcedureTypeSpecifier.DoItCaseInsensitive(@Src[NextAtomStart])
      then exit;
    else
      exit;
    end;
    Result:=true;
  end;

var
  r: PChar;
  Block: PBlock;
  CommentStartPos: LongInt;
  CommentEndPos: LongInt;
begin
  p:=StartPos;
  if EndPos>length(Src) then EndPos:=length(Src)+1;
  AtomStart:=p;
  InFirstLine:=true;
  repeat
    LastAtomStart:=AtomStart;
    LastAtomEnd:=p;
    AtomStartedBlock:=false;
    AtomEndedBlock:=false;
    ReadRawNextPascalAtom(Src,p,AtomStart,NestedComments);
    if InFirstLine and (not PositionsInSameLine(Src,LastAtomEnd,AtomStart)) then
      InFirstLine:=false;
    //DebugLn(['TFullyAutomaticBeautifier.ParseSource Atom=',copy(Src,AtomStart,p-AtomStart)]);
    if p>EndPos then begin
      if (AtomStart<EndPos) then begin
        LastAtomStart:=AtomStart;
        LastAtomEnd:=p;
      end else begin
        // EndPos between two atom: in space or comment
        CommentStartPos:=FindNextNonSpace(Src,LastAtomEnd);
        LastAtomStart:=0;
        LastAtomEnd:=0;
        if CommentStartPos<EndPos then begin
          CommentEndPos:=FindCommentEnd(Src,CommentStartPos,NestedComments);
          if CommentEndPos>EndPos then begin
            // EndPos is in comment => return bounds of comment
            LastAtomStart:=CommentStartPos;
            LastAtomEnd:=CommentEndPos;
          end;
        end;
      end;
      break;
    end else if AtomStart=EndPos then
      break;

    // check if found first inner atom of current block
    FirstAtomOnNewLine:=IsFirstNonSpaceCharInLine(Src,AtomStart);
    if FirstAtomOnNewLine and (Stack.Top>=0) then begin
      Block:=@Stack.Stack[Stack.Top];
      if (Block^.InnerStartPos<0) then
        Block^.InnerStartPos:=AtomStart;
    end;

    r:=@Src[AtomStart];

    case UpChars[r^] of
    'B':
      if CompareIdentifiers('BEGIN',r)=0 then begin
        while Stack.TopType
        in (bbtAllIdentifierSections+bbtAllCodeSections+bbtAllBrackets
          +[bbtDefinition,bbtProcedureModifiers,bbtProcedureHead,bbtStatement])
        do
          EndBlock;
        case Stack.TopType of
        bbtNone:
          BeginBlock(bbtMainBegin);
        bbtProcedure,bbtFunction:
          BeginBlock(bbtProcedureBegin);
        bbtMainBegin,bbtProcedureBegin,bbtStatement:
          BeginBlock(bbtFreeBegin);
        bbtIfThen,bbtIfElse:
          BeginBlock(bbtIfBegin);
        else
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtFreeBegin);
        end;
      end;
    'C':
      case UpChars[r[1]] of
      'A': // CA
        if CompareIdentifiers('CASE',r)=0 then begin
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtCase);
        end;
      'L': // CL
        if CompareIdentifiers('CLASS',r)=0 then begin
          if Stack.TopType=bbtDefinition then
            BeginClass;
        end;
      'O': // CO
        if CompareIdentifiers('CONST',r)=0 then
          StartIdentifierSection(bbtConstSection)
        else if CompareIdentifiers('CONSTRUCTOR',r)=0 then
          StartProcedure(bbtProcedure);
      'P': // CP
        if CompareIdentifiers('CPPCLASS',r)=0 then begin
          if Stack.TopType=bbtDefinition then
            BeginClass;
        end;
      end;
    'D':
      case UpChars[r[1]] of
      'O':
        if CompareIdentifiers('DO',r)=0 then begin
          case Stack.TopType of
            bbtWhile: BeginBlock(bbtWhileDo);
            bbtFor: BeginBlock(bbtForDo);
            bbtWith: BeginBlock(bbtWithDo);
          end;
        end;
      'E':
        if CompareIdentifiers('DESTRUCTOR',r)=0 then
          StartProcedure(bbtProcedure);
      'I':
        if CompareIdentifiers('DISPINTERFACE',r)=0 then begin
          if Stack.TopType=bbtDefinition then begin
            BeginBlock(bbtClassInterface);
          end;
        end;
      end;
    'E':
      case UpChars[r[1]] of
      'L': // EL
        if CompareIdentifiers('ELSE',r)=0 then begin
          // common syntax error: open brackets in IF expression => ignore
          while Stack.TopType in bbtAllBrackets do
            EndBlock;

          if Stack.TopType=bbtStatement then
            EndBlock;
          while Stack.TopType in [bbtFor,bbtForDo] do EndBlock;
          case Stack.TopType of
          bbtIfThen:
            begin
              EndBlock;
              BeginBlock(bbtIfElse);
            end;
          bbtCaseOf,bbtCaseLabel,bbtCaseColon:
            begin
              if Stack.TopType=bbtCaseColon then
                EndBlock;
              if Stack.TopType=bbtCaseLabel then
                EndBlock;
              EndBlock; // close bbtCaseOf
              BeginBlock(bbtCaseElse);
            end;
          end;
        end;
      'N': // EN
        if CompareIdentifiers('END',r)=0 then begin
          // common syntax error: open brackets in statements => ignore
          while Stack.TopType in bbtAllBrackets do
            EndBlock;
          // statements can be closed by end without semicolon
          while Stack.TopType in bbtAllAutoEnd do
            EndBlock;

          if Stack.TopType=bbtProcedureModifiers then
            EndBlock;
          if Stack.TopType=bbtProcedureHead then
            EndBlock;
          if Stack.TopType in bbtAllProcedures then
            EndBlock;
          if Stack.TopType=bbtClassSection then
            EndBlock;

          case Stack.TopType of
          bbtMainBegin,bbtFreeBegin,
          bbtRecord,bbtClass,bbtClassInterface,bbtTry,bbtFinally,bbtExcept,
          bbtCase,bbtIfBegin:
            EndBlock;
          bbtCaseLabel,bbtCaseColon:
            begin
              if Stack.TopType=bbtCaseColon then
                EndBlock;
              EndBlock; // close bbtCaseLabel
              EndBlock; // close bbtCaseOf
              EndBlock; // close bbtCase
            end;
          bbtCaseElse,bbtCaseOf:
            begin
              EndBlock;
              EndBlock; // close bbtCase
            end;
          bbtProcedureBegin:
            begin
              EndBlock;
              if Stack.TopType in bbtAllProcedures then
                EndBlock;
            end;
          bbtInterface,bbtImplementation,bbtInitialization,bbtFinalization:
            EndBlock;
          end;

          while Stack.TopType in bbtAllAutoEnd do
            EndBlock;
        end;
      'X': // EX
        if CompareIdentifiers('EXCEPT',r)=0 then begin
          if Stack.TopType=bbtTry then begin
            EndBlock;
            BeginBlock(bbtExcept);
          end;
        end;
      end;
    'F':
      case UpChars[r[1]] of
      'I': // FI
        if CompareIdentifiers('FINALIZATION',r)=0 then begin
          while Stack.Top>=0 do
            EndBlock;
          if Stack.TopType=bbtNone then
            BeginBlock(bbtFinalization);
        end else if CompareIdentifiers('FINALLY',r)=0 then begin
          if Stack.TopType=bbtTry then begin
            EndBlock;
            BeginBlock(bbtFinally);
          end;
        end;
      'O': // FO
        if CompareIdentifiers('FOR',r)=0 then begin
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtFor)
        end else if CompareIdentifiers('FORWARD',r)=0 then begin
          if Stack.TopType=bbtProcedureModifiers then
            EndBlock;
          if Stack.TopType=bbtProcedureHead then
            EndBlock;
          if Stack.TopType in bbtAllProcedures then
            EndBlock;
        end;
      'U': // FU
        if CompareIdentifiers('FUNCTION',r)=0 then
          StartProcedure(bbtFunction);
      end;
    'I':
      case UpChars[r[1]] of
      'F': // IF
        if p-AtomStart=2 then begin
          // 'IF'
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtIf);
        end;
      'N': // IN
        case UpChars[r[2]] of
        'I': // INI
          if CompareIdentifiers('INITIALIZATION',r)=0 then begin
            while Stack.Top>=0 do
              EndBlock;
            if Stack.TopType=bbtNone then
              BeginBlock(bbtInitialization);
          end;
        'T': // INT
          if CompareIdentifiers('INTERFACE',r)=0 then begin
            case Stack.TopType of
            bbtNone:
              BeginBlock(bbtInterface);
            bbtDefinition:
              BeginBlock(bbtClassInterface);
            end;
          end;
        end;
      'M': // IM
        if CompareIdentifiers('IMPLEMENTATION',r)=0 then begin
          while Stack.Top>=0 do
            EndBlock;
          if Stack.TopType=bbtNone then
            BeginBlock(bbtImplementation);
        end;
      end;
    'L':
      if CompareIdentifiers('LABEL',r)=0 then
        StartIdentifierSection(bbtLabelSection);
    'O':
      case UpChars[r[1]] of
      'B':
        case UpChars[r[2]] of
        'J':
          case UpChars[r[3]] of
          'C':
            case UpChars[r[4]] of
            'C':
              if (CompareIdentifiers('ObjCCategory',r)=0)
              or (CompareIdentifiers('ObjCClass',r)=0) then begin
                if Stack.TopType=bbtDefinition then
                  BeginClass;
              end;
            'P':
              if CompareIdentifiers('ObjCProtocol',r)=0 then begin
                if Stack.TopType=bbtDefinition then
                  BeginBlock(bbtClassInterface);
              end;
            end;
          'E':
            if CompareIdentifiers('OBJECT',r)=0 then begin
              if Stack.TopType=bbtDefinition then
                BeginClass;
            end;
          end;
        end;
      'F': // OF
        if CompareIdentifiers('OF',r)=0 then begin
          case Stack.TopType of
          bbtCase:
            BeginBlock(bbtCaseOf);
          bbtClass,bbtClassInterface:
            EndBlock;
          end;
        end;
      'P': // OP
        if CompareIdentifiers('OPERATOR',r)=0 then
          StartProcedure(bbtFunction);
      end;
    'P':
      case UpChars[r[1]] of
      'R': // PR
        case UpChars[r[2]] of
        'I': // PRI
          if (CompareIdentifiers('PRIVATE',r)=0) then
            StartClassSection;
        'O': // PRO
          case UpChars[r[3]] of
          'P': // PROP
            if (CompareIdentifiers('PROPERTY',r)=0) then
              StartProperty;
          'T': // PROT
            if (CompareIdentifiers('PROTECTED',r)=0) then
              StartClassSection;
          'C': // PROC
            if CompareIdentifiers('PROCEDURE',r)=0 then
              StartProcedure(bbtProcedure);
          end;
        end;
      'U': // PU
        if (CompareIdentifiers('PUBLIC',r)=0)
        or (CompareIdentifiers('PUBLISHED',r)=0) then
          StartClassSection;
      end;
    'R':
      case UpChars[r[1]] of
      'E': // RE
        case UpChars[r[2]] of
        'C': // REC
          if CompareIdentifiers('RECORD',r)=0 then
            BeginBlock(bbtRecord);
        'P': // REP
          if CompareIdentifiers('REPEAT',r)=0 then
            if Stack.TopType in bbtAllStatements then
              BeginBlock(bbtRepeat);
        'S': // RES
          if CompareIdentifiers('RESOURCESTRING',r)=0 then
            StartIdentifierSection(bbtResourceStringSection);
        end;
      end;
    'S':
      if (CompareIdentifiers('STRICT',r)=0) then
        StartClassSection;
    'T':
      case UpChars[r[1]] of
      'H': // TH
        if CompareIdentifiers('THEN',r)=0 then begin
          // common syntax error: open brackets in if expression => ignore
          while Stack.TopType in bbtAllBrackets do
            EndBlock;
          if Stack.TopType=bbtIf then
            BeginBlock(bbtIfThen);
        end;
      'R': // TR
        if CompareIdentifiers('TRY',r)=0 then begin
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtTry);
        end;
      'Y': // TY
        if CompareIdentifiers('TYPE',r)=0 then begin
          if Stack.TopType<>bbtDefinition then
            StartIdentifierSection(bbtTypeSection);
        end;
      end;
    'U':
      case UpChars[r[1]] of
      'S': // US
        if CompareIdentifiers('USES',r)=0 then begin
          if Stack.TopType in [bbtNone,bbtInterface,bbtImplementation] then
            BeginBlock(bbtUsesSection);
        end;
      'N': // UN
        if CompareIdentifiers('UNTIL',r)=0 then begin
          EndTopMostBlock(bbtRepeat);
        end;
      end;
    'V':
      if CompareIdentifiers('VAR',r)=0 then begin
        StartIdentifierSection(bbtVarSection);
      end;
    'W':
      case UpChars[r[1]] of
      'H': // WH
        if CompareIdentifiers('WHILE',r)=0 then begin
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtWhile)
        end;
      'I': // WI
        if CompareIdentifiers('WITH',r)=0 then begin
          if Stack.TopType in bbtAllStatements then
            BeginBlock(bbtWith)
        end;
      end;
    ';':
      begin
        // common syntax error: unclosed bracket => ignore it
        while Stack.TopType in [bbtStatementRoundBracket,bbtStatementEdgedBracket] do
          EndBlock;
        case Stack.TopType of
        bbtUsesSection,bbtDefinition,bbtProperty:
          EndBlock;
        bbtIfThen,bbtIfElse,bbtStatement,bbtFor,bbtForDo,bbtCaseColon,bbtCaseLabel:
          begin
            while Stack.TopType in bbtAllAutoEnd do
              EndBlock;
          end;
        bbtProcedureHead:
          if CheckProcedureModifiers then
            BeginBlock(bbtProcedureModifiers)
          else
            EndProcedureHead;
        bbtProcedureModifiers:
          if not CheckProcedureModifiers then
            EndProcedureHead;
        bbtClassSection,bbtClass:
          begin
            if Stack.TopType=bbtClassSection then
              EndBlock;
            EndBlock;
            if Stack.TopType=bbtDefinition then
              EndBlock;
          end;
        end;
      end;
    ':':
      if p-AtomStart=1 then begin
        // colon
        case Stack.TopType of
        bbtCaseLabel:
          BeginBlock(bbtCaseColon);
        bbtIf:
          EndBlock;
        bbtIfThen,bbtIfElse:
          begin
            EndBlock;
            if Stack.TopType=bbtIf then
              EndBlock;
          end;
        end;
      end;
    '(':
      if p-AtomStart=1 then begin
        // round bracket open
        case Stack.TopType of
        bbtProcedureHead:
          BeginBlock(bbtProcedureParamList);
        else
          if Stack.TopType in bbtAllStatements then begin
            // ignore brackets in statements, there are no consistent rules
            // to indent them
            // Note: keep in mind: bbtCaseLabel
          end else
            BeginBlock(bbtTypeRoundBracket);
        end;
      end;
    ')':
      if p-AtomStart=1 then begin
        // round bracket close
        EndTopMostBlock(bbtStatementEdgedBracket);
        case Stack.TopType of
        bbtProcedureParamList,bbtTypeRoundBracket,bbtStatementRoundBracket:
          EndBlock;
        end;
      end;
    '[':
      if p-AtomStart=1 then begin
        // edge bracket open
        if Stack.TopType in bbtAllStatements then
          BeginBlock(bbtStatementEdgedBracket)
        else
          BeginBlock(bbtTypeEdgedBracket);
      end;
    ']':
      if p-AtomStart=1 then begin
        // edge bracket close
        EndTopMostBlock(bbtStatementRoundBracket);
        case Stack.TopType of
        bbtTypeEdgedBracket,bbtStatementEdgedBracket:
          EndBlock;
        end;
      end;
    end;
    // check blocks that start without keyword/symbol
    if (not AtomStartedBlock) and (not AtomEndedBlock)
    and (r^<>';') then begin
      if (Stack.TopType in bbtAllIdentifierSections)
      and (IsIdentStartChar[Src[AtomStart]]) then begin
        // new definition
        BeginBlock(bbtDefinition);
      end else if (Stack.TopType=bbtCaseOf) then begin
        // new case label
        BeginBlock(bbtCaseLabel);
      end else if (Stack.TopType in bbtAllStatementParents) then begin
        // new statement
        BeginBlock(bbtStatement);
      end;
    end;

    if FirstAtomOnNewLine and (Stack.Top>=0)
    and (not AtomStartedBlock) and (not AtomEndedBlock)
    and ((not InFirstLine) or LearnFromFirstLine)
    and (Policies<>nil)
    then begin
      Block:=@Stack.Stack[Stack.Top];
      if Block^.InnerIdent<0 then begin
        UpdateBlockInnerIndent;
        if (Block^.InnerIdent>=0) then begin
          Policies.AddIndent(Block^.Typ,bbtNone,AtomStart,Block^.InnerIdent);
          {$IFDEF ShowCodeBeautifierLearn}
          DebugLn([GetIndentStr(Stack.Top*2),'Indentation learned for bbtNone: ',EnumToStr(Block^.Typ),' Indent=',Block^.InnerIdent,' at ',PosToStr(p)]);
          {$ENDIF}
        end;
      end;
    end;
  until false;
end;

procedure TFullyAutomaticBeautifier.ParseSource(const Src: string; StartPos,
  EndPos: integer; NestedComments: boolean; Stack: TFABBlockStack;
  Policies: TFABPolicies; LearnFromFirstLine: boolean);
var
  LastAtomStart, LastAtomEnd: integer;
begin
  ParseSource(Src,StartPos,EndPos,NestedComments,Stack,Policies,
              LastAtomStart,LastAtomEnd,LearnFromFirstLine);
end;

function TFullyAutomaticBeautifier.FindPolicyInExamples(StartCode: TCodeBuffer;
  Typ, SubTyp: TFABBlockType; UseNoneIfNotFound, UseSmallestIfNotFound: boolean
  ): TFABPolicies;

  function CheckCode(Code: TCodeBuffer; out Policies: TFABPolicies): boolean;
  // result=false : abort
  var
    AVLNode: TAVLTreeNode;
    Stack: TFABBlockStack;
  begin
    Policies:=nil;
    if Code=nil then exit(true);
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.FindPolicyInExamples ',Code.Filename]);
    {$ENDIF}
    // search Policies for code
    AVLNode:=FCodePolicies.FindKey(Code,@CompareCodeWithFABPolicy);
    if AVLNode=nil then begin
      Policies:=TFABPolicies.Create;
      Policies.Code:=Code;
      FCodePolicies.Add(Policies);
    end else
      Policies:=TFABPolicies(AVLNode.Data);
    if Policies.CodeChangeStep<>Code.ChangeStep then begin
      // parse code
      Policies.Clear;
      Policies.CodeChangeStep:=Code.ChangeStep;
      Stack:=TFABBlockStack.Create;
      try
        ParseSource(Code.Source,1,length(Code.Source)+1,
           GetNestedCommentsForCode(Code),Stack,Policies);
      finally
        Stack.Free;
      end;
    end;
    // search policy
    if Policies.GetIndent(Typ,SubTyp,UseNoneIfNotFound,UseSmallestIfNotFound)>=0
    then begin
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.FindPolicyInExamples found in ',
        Code.Filename,' ',EnumToStr(Typ),'/',EnumToStr(SubTyp)]);
      {$ENDIF}
      exit;
    end;
    Policies:=nil;
    Result:=true;
  end;

var
  CodeBuffers: TFPList;
  i: Integer;
  Code: TCodeBuffer;
  Step: Integer;
  Filenames: TStrings;
  Abort: boolean;
begin
  Result:=nil;
  if not Assigned(OnGetExamples) then exit;
  Step:=0;
  repeat
    // get examples for current step
    CodeBuffers:=nil;
    Filenames:=nil;
    try
      OnGetExamples(Self,StartCode,Step,CodeBuffers,Filenames);
      if (CodeBuffers=nil) and (Filenames=nil) then exit;
      // search policy in every example
      if CodeBuffers<>nil then
        for i:=0 to CodeBuffers.Count-1 do begin
          Code:=TCodeBuffer(CodeBuffers[i]);
          if not CheckCode(Code,Result) then exit;
          if Result<>nil then exit;
        end;
      if (Filenames<>nil) and Assigned(OnLoadFile) then
        for i:=0 to Filenames.Count-1 do begin
          Abort:=false;
          Code:=nil;
          OnLoadFile(Self,Filenames[i],Code,Abort);
          if Abort then exit;
          if Code=nil then continue;
          if not CheckCode(Code,Result) then exit;
          if Result<>nil then exit;
        end;
    finally
      CodeBuffers.Free;
      Filenames.Free;
    end;
    // next step
    inc(Step);
  until false;
end;

function TFullyAutomaticBeautifier.GetNestedCommentsForCode(Code: TCodeBuffer
  ): boolean;
begin
  Result:=true;
  if Assigned(OnGetNestedComments) then
    OnGetNestedComments(Self,Code,Result);
end;

function TFullyAutomaticBeautifier.AdjustByNextAtom(
  const Source: string; CleanPos: integer; NestedComments: boolean;
  Stack: TFABBlockStack; out TopType: TFABBlockType; out TopTypeValid: boolean
  ): integer;
{ For example:
    if expr then
      begin
        |DoSomething;

    if expr then
      begin
      |end;
}

  function StackTopType: TFABBlockType;
  var
    i: Integer;
  begin
    i:=AdjustByNextAtom;
    if (i>=0) and (i<=Stack.Top) then
      Result:=Stack.Stack[i].Typ
    else
      Result:=bbtNone;
  end;

  procedure EndBlock(aCount: integer = 1);
  begin
    dec(AdjustByNextAtom,aCount);
    TopTypeValid:=false;
  end;

  procedure BeginBlock(Typ: TFABBlockType);
  begin
    TopType:=Typ;
    TopTypeValid:=true;
  end;

  procedure EndIdentifierSectionAndProc;
  begin
    if StackTopType=bbtDefinition then
      EndBlock;
    if StackTopType in bbtAllIdentifierSections then
      EndBlock;
  end;

  procedure StartProcedure;
  begin
    if StackTopType=bbtDefinition then
      EndBlock;
    if StackTopType in (bbtAllIdentifierSections-[bbtClassSection]) then
      EndBlock;
    BeginBlock(bbtProcedure);
  end;

  function IsMethodDeclaration: boolean;
  var
    i: Integer;
  begin
    i:=AdjustByNextAtom;
    Result:=(StackTopType in bbtAllProcedures)
      and (i>0)
      and (Stack.Stack[i-1].Typ=bbtClassSection);
  end;

  procedure EndClassSection;
  begin
    if StackTopType=bbtClassSection then
      EndBlock
    else if IsMethodDeclaration then
      EndBlock(2);
  end;

  procedure EndBigSection;
  var
    i: Integer;
  begin
    i:=AdjustByNextAtom;
    if i>=0 then
      EndBlock(i+1);
  end;

  procedure EndTopMostBlock(BlockTyp: TFABBlockType);
  var
    i: LongInt;
  begin
    i:=Stack.TopMostIndexOf(BlockTyp);
    if i>=0 then
      AdjustByNextAtom:=i-1;
  end;

var
  AtomStart: integer;
  r: PChar;
  p: LongInt;
begin
  {$IFDEF VerboseIndenter}
  DebugLn(['TFullyAutomaticBeautifier.AdjustByNextAtom START']);
  {$ENDIF}
  Result:=Stack.Top;
  TopType:=bbtNone;
  TopTypeValid:=false;
  if Result<0 then exit;
  if (CleanPos<1) or (CleanPos>length(Source))
  or (Source[CleanPos] in [#0..#31,' ']) then
    exit;
  p:=CleanPos;
  ReadRawNextPascalAtom(Source,p,AtomStart,NestedComments);
  {$IFDEF VerboseIndenter}
  DebugLn(['TFullyAutomaticBeautifier.AdjustByNextAtom ',AtomStart<>CleanPos,' CleanPos=',dbgstr(copy(Source,CleanPos,10)),' AtomStart=',dbgstr(copy(Source,AtomStart,10))]);
  {$ENDIF}
  if AtomStart<>CleanPos then exit;
  {$IFDEF VerboseIndenter}
  DebugLn(['TFullyAutomaticBeautifier.AdjustByNextAtom Atom=',copy(Source,AtomStart,p-AtomStart)]);
  {$ENDIF}
  TopTypeValid:=true;
  r:=@Source[AtomStart];
  case UpChars[r^] of
  'B':
    if CompareIdentifiers('BEGIN',r)=0 then begin
      if StackTopType=bbtDefinition then
        EndBlock;
      if StackTopType in bbtAllIdentifierSections then
        EndBlock;
      case StackTopType of
      bbtIfThen:
        BeginBlock(bbtIfBegin);
      bbtProcedure:
        BeginBlock(bbtProcedureBegin);
      end;
    end;
  'C':
    if CompareIdentifiers('CONST',r)=0 then begin
      EndIdentifierSectionAndProc;
      if StackTopType=bbtProcedure then
        BeginBlock(bbtLabelSection);
    end;
  'E':
    case UpChars[r[1]] of
    'L': // EL
      if CompareIdentifiers('ELSE',r)=0 then begin
        // common syntax error: open brackets in statements => ignore
        while StackTopType in bbtAllBrackets do
          EndBlock;
        while StackTopType in [bbtFor,bbtForDo,bbtStatement] do
          EndBlock;
        case StackTopType of
        bbtCaseOf,bbtCaseLabel,bbtCaseColon:
          begin
            if StackTopType=bbtCaseColon then
              EndBlock;
            if StackTopType=bbtCaseLabel then
              EndBlock;
            EndBlock; // close bbtCaseOf
            BeginBlock(bbtCaseElse);
          end;
        bbtIfThen:
          EndBlock;
        end;
      end;
    'N': // EN
      if CompareIdentifiers('END',r)=0 then begin
        // common syntax error: open brackets in statements => ignore
        while StackTopType in bbtAllBrackets do
          EndBlock;
        // statements can be closed by end without semicolon
        while StackTopType in bbtAllAutoEnd do
          EndBlock;
        if IsMethodDeclaration then
          EndBlock;
        if StackTopType=bbtClassSection then
          EndBlock;

        case StackTopType of
        bbtMainBegin,bbtFreeBegin,
        bbtRecord,bbtClass,bbtClassInterface,bbtTry,bbtFinally,bbtExcept,
        bbtCase,bbtIfBegin:
          EndBlock;
        bbtCaseOf,bbtCaseLabel,bbtCaseColon:
          begin
            if StackTopType=bbtCaseColon then
              EndBlock;
            if StackTopType=bbtCaseLabel then
              EndBlock;
            EndBlock; // close bbtCaseOf
            EndBlock; // close bbtCase
          end;
        bbtCaseElse:
          begin
            EndBlock;
            EndBlock; // close bbtCase
          end;
        bbtProcedureBegin:
          EndBlock;
        bbtInterface,bbtImplementation,bbtInitialization,bbtFinalization:
          EndBlock;
        end;
      end;
    'X': // EX
      if CompareIdentifiers('EXCEPT',r)=0 then begin
        if StackTopType=bbtTry then
          EndBlock;
      end;
    end;
  'F':
    case UpChars[r[1]] of
    'I': // FI
      if CompareIdentifiers('FINALIZATION',r)=0 then begin
        EndBigSection;
      end else if CompareIdentifiers('FINALLY',r)=0 then begin
        if StackTopType=bbtTry then
          EndBlock;
      end;
    end;
  'I':
    case UpChars[r[1]] of
    'F': // IF
      if p-AtomStart=2 then begin
        BeginBlock(bbtIf);
      end;
    'N': // IN
      case UpChars[r[2]] of
      'I': // INI
        if CompareIdentifiers('INITIALIZATION',r)=0 then
          EndBigSection;
      end;
    'M': // IM
      if CompareIdentifiers('IMPLEMENTATION',r)=0 then begin
        EndBigSection;
      end;
    end;
  'L':
    if CompareIdentifiers('LABEL',r)=0 then begin
      EndIdentifierSectionAndProc;
      if StackTopType=bbtProcedure then
        BeginBlock(bbtLabelSection);
    end;
  'P':
    case UpChars[r[1]] of
    'R': // PR
      case UpChars[r[2]] of
      'I': // PRI
        if CompareIdentifiers('PRIVATE',r)=0 then
          EndClassSection;
      'O': // PRO
        case UpChars[r[3]] of
        'C': // PROC
          if CompareIdentifiers('PROCEDURE',r)=0 then
            StartProcedure;
        'T': // PROT
          if CompareIdentifiers('PROTECTED',r)=0 then
            EndClassSection;
        end;
      end;
    'U': // PU
      if (CompareIdentifiers('PUBLIC',r)=0)
      or (CompareIdentifiers('PUBLISHED',r)=0) then
        EndClassSection;
    end;
  'R':
    case UpChars[r[1]] of
    'E': // RE
      case UpChars[r[2]] of
      'S': // RES
        if CompareIdentifiers('RESOURCESTRING',r)=0 then
          EndIdentifierSectionAndProc;
      end;
    end;
  'S':
    if (CompareIdentifiers('STRICT',r)=0) then
      EndClassSection;
  'T':
    case UpChars[r[1]] of
    'Y': // TY
      if CompareIdentifiers('TYPE',r)=0 then begin
        EndIdentifierSectionAndProc;
        if StackTopType=bbtProcedure then
          BeginBlock(bbtTypeSection);
      end;
    end;
  'U':
    case UpChars[r[1]] of
    'N': // UN
      if CompareIdentifiers('UNTIL',r)=0 then begin
        EndTopMostBlock(bbtRepeat);
      end;
    end;
  'V':
    if CompareIdentifiers('VAR',r)=0 then begin
      EndIdentifierSectionAndProc;
      if StackTopType=bbtProcedure then
        BeginBlock(bbtVarSection);
    end;
  end;
  {$IFDEF VerboseIndenter}
  if (Stack.Top<>Result)  then
    DebugLn(['TFullyAutomaticBeautifier.AdjustByNextAtom block close: Stack.Top=',Stack.Top,' Result=',Result]);
  if TopTypeValid then
    DebugLn(['TFullyAutomaticBeautifier.AdjustByNextAtom block open: TopType=',EnumToStr(TopType)]);
  {$ENDIF}
end;

procedure TFullyAutomaticBeautifier.WriteDebugReport(Msg: string;
  Stack: TFABBlockStack);
var
  i: Integer;
  Block: PBlock;
begin
  DebugLn(['TFullyAutomaticBeautifier.WriteDebugReport ',Msg]);
  if Stack<>nil then begin
    for i:=0 to Stack.Top do begin
      Block:=@Stack.Stack[i];
      DebugLn([GetIndentStr(i*2),' : Typ=',EnumToStr(Block^.Typ),' StartPos=',Block^.StartPos,' InnerIdent=',Block^.InnerIdent,' InnerStartPos=',Block^.InnerStartPos]);
    end;
  end;
end;

constructor TFullyAutomaticBeautifier.Create;
begin
  FCodePolicies:=TAVLTree.Create(@CompareFABPoliciesWithCode);
  DefaultTabWidth:=4;
  UseDefaultIndentForTypes:=[bbtStatement,bbtStatementRoundBracket,
    bbtStatementEdgedBracket,bbtTypeRoundBracket,bbtTypeEdgedBracket];
end;

destructor TFullyAutomaticBeautifier.Destroy;
begin
  Clear;
  FreeAndNil(FCodePolicies);
  inherited Destroy;
end;

procedure TFullyAutomaticBeautifier.Clear;
begin
  FCodePolicies.FreeAndClear;
end;

function TFullyAutomaticBeautifier.GetIndent(const Source: string;
  CleanPos: integer; NewNestedComments: boolean;
  UseLineStart: boolean; out Indent: TFABIndentationPolicy;
  ContextLearn: boolean; const InsertText: string): boolean;
var
  Block: TBlock;
  SubType: TFABBlockType;
  SubTypeValid: Boolean;

  function CheckPolicies(Policies: TFABPolicies; var Found: boolean;
    UseSmallestIfNotFound: boolean): boolean;
  // returns true to stop searching
  var
    BlockIndent: LongInt;
  begin
    Result:=false;
    Found:=false;
    if (Policies=nil) then exit;
    if SubTypeValid then
      BlockIndent:=Policies.GetIndent(Block.Typ,SubType,true,UseSmallestIfNotFound)
    else
      BlockIndent:=Policies.GetSmallestIndent(Block.Typ);
    if (BlockIndent<0) then exit;
    // policy found
    {$IFDEF VerboseIndenter}
    if SubTypeValid then
      DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' BlockIndent=',BlockIndent])
    else
      DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',EnumToStr(Block.Typ),' BlockIndent=',BlockIndent]);
    //Policies.WriteDebugReport;
    {$ENDIF}
    Indent.Indent:=GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)
                   +BlockIndent;
    Indent.IndentValid:=true;
    Result:=true;
    Found:=true;
  end;

var
  Stack: TFABBlockStack;
  Policies: TFABPolicies;
  LastAtomStart, LastAtomEnd: integer;
  StackIndex: LongInt;
  PrevLineAtomEndPos: LongInt;
  InsertTextStartPos: Integer;
  ExamplePolicies: TFABPolicies;
begin
  Result:=false;
  FillByte(Indent,SizeOf(Indent),0);

  CleanPos:=FindStartOfAtom(Source,CleanPos);
  //DebugLn(['TFullyAutomaticBeautifier.GetIndent ']);
  if CleanPos<1 then exit;

  if UseLineStart and (InsertText='') then begin
    while (CleanPos<=length(Source)) and (Source[CleanPos] in [' ',#9]) do
      inc(CleanPos);
  end;

  Block:=CleanBlock;
  Policies:=nil;
  Stack:=TFABBlockStack.Create;
  try
    if ContextLearn then
      Policies:=TFABPolicies.Create;
    {$IFDEF ShowCodeBeautifierLearn}
    if Policies=nil then
      Policies:=TFABPolicies.Create;
    Policies.Code:=TCodeBuffer.Create;
    Policies.Code.Source:=Source;
    {$ENDIF}
    // parse source in front
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent "',dbgstr(copy(Source,CleanPos-10,10)),'|',dbgstr(copy(Source,CleanPos,10)),'"']);
    {$ENDIF}
    ParseSource(Source,1,CleanPos,NewNestedComments,Stack,Policies,
                LastAtomStart,LastAtomEnd);
    {$IFDEF VerboseIndenter}
    WriteDebugReport('After parsing code in front:',Stack);
    {$ENDIF}
    if (LastAtomStart>0) and (CleanPos>LastAtomStart) then begin
      // in comment or atom
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: position in middle of atom, e.g. comment']);
      {$ENDIF}
      GetDefaultSrcIndent(Source,CleanPos,NewNestedComments,Indent);
      exit(Indent.IndentValid);
    end;
    if LastAtomStart>0 then CleanPos:=LastAtomStart;

    StackIndex:=Stack.Top;
    SubType:=bbtNone;
    SubTypeValid:=false;
    if UseLineStart then begin
      if InsertText='' then begin
        StackIndex:=AdjustByNextAtom(Source,CleanPos,
                                  NewNestedComments,Stack,SubType,SubTypeValid);
      end else begin
        InsertTextStartPos:=1;
        while (InsertTextStartPos<=length(InsertText))
        and (InsertText[InsertTextStartPos] in [' ',#9]) do
          inc(InsertTextStartPos);
        StackIndex:=AdjustByNextAtom(InsertText,InsertTextStartPos,
                                  NewNestedComments,Stack,SubType,SubTypeValid);
      end;
    end;
    if (StackIndex<0) then begin
      // no context
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: no context']);
      {$ENDIF}
      Indent.Indent:=0;
      Indent.IndentValid:=true;
      exit(Indent.IndentValid);
    end;

    if (Stack.Stack[StackIndex].Typ in UseDefaultIndentForTypes) then begin
      // use default indent
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent use default for this type: ',EnumToStr(Stack.Stack[StackIndex].Typ)]);
      {$ENDIF}
      GetDefaultSrcIndent(Source,CleanPos,NewNestedComments,Indent);
      exit(Indent.IndentValid);
    end;

    if (StackIndex<Stack.Top) and (not SubTypeValid) then begin
      // block(s) closed by next token
      // use indent of block start
      Block:=Stack.Stack[StackIndex+1];
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent next token close block: ',EnumToStr(Stack.TopType),' Block=',dbgstr(copy(Source,Block.StartPos,20))]);
      {$ENDIF}
      Indent.Indent:=GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth);
      Indent.IndentValid:=true;
      exit(true);
    end;
    Block:=Stack.Stack[StackIndex];

    // search last non empty line start
    PrevLineAtomEndPos:=CleanPos;
    while (PrevLineAtomEndPos>0)
    and (not (Source[PrevLineAtomEndPos] in [#10,#13])) do
      dec(PrevLineAtomEndPos);
    if (PrevLineAtomEndPos>0) then
      PrevLineAtomEndPos:=FindPrevNonSpace(Source,PrevLineAtomEndPos);

    //debugln(['TFullyAutomaticBeautifier.GetIndent BEFORE check for last sibling ',Stack.LastBlockClosed.StartPos,' ',PositionsInSameLine(Source,Stack.LastBlockClosed.StartPos,Block.StartPos),' SubTypeValid=',SubTypeValid]);
    if (Stack.LastBlockClosed.StartPos>0)
    and (not PositionsInSameLine(Source,Stack.LastBlockClosed.StartPos,Block.StartPos))
    and ((not SubTypeValid) or (SubType in bbtAllAlignToSibling))
    then begin
      //debugln(['TFullyAutomaticBeautifier.GetIndent BEFORE2 check for last sibling ',Stack.LastBlockClosedAt,' ',PositionsInSameLine(Source,Stack.LastBlockClosedAt,PrevLineAtomEndPos)]);
      // a child block was closed that was started in another line than current block
      // and this subtype aligns as its siblings
      if (Stack.LastBlockClosedAt>0)
      and PositionsInSameLine(Source,Stack.LastBlockClosedAt,PrevLineAtomEndPos)
      then begin
        // between block end and CleanPos are only empty lines
        // => indent like the last child block one
        {$IFDEF VerboseIndenter}
        DebugLn(['TFullyAutomaticBeautifier.GetIndent line after end of last sibling block, copy indent']);
        {$ENDIF}
        Indent.Indent:=GetLineIndentWithTabs(Source,
                                Stack.LastBlockClosed.StartPos,DefaultTabWidth);
      end else begin
        // between block end and CleanPos are non empty lines
        // => indent like the last non empty line
        {$IFDEF VerboseIndenter}
        DebugLn(['TFullyAutomaticBeautifier.GetIndent unstructural code found, indent as last line: LastBlockClosedAt=',dbgstr(copy(Source,Stack.LastBlockClosedAt,10)),' PrevAtom=',dbgstr(copy(Source,PrevLineAtomEndPos,10))]);
        {$ENDIF}
        Indent.Indent:=GetLineIndentWithTabs(Source,
                                            PrevLineAtomEndPos,DefaultTabWidth);
      end;
      Indent.IndentValid:=true;
      exit(true);
    end;

    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' indent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
    {$ENDIF}
    if Policies<>nil then begin
      // check source in front for good match
      if CheckPolicies(Policies,Result,false) then exit;

      // parse source behind
      ParseSource(Source,CleanPos,length(Source)+1,NewNestedComments,Stack,
                  Policies,false);
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed source behind']);
      {$ENDIF}
      // check source for good match
      if CheckPolicies(Policies,Result,false) then exit;
    end;

    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent Valid=',Indent.IndentValid,' Indent=',Indent.Indent]);
    {$ENDIF}

    // parse examples for good match
    ExamplePolicies:=FindPolicyInExamples(nil,Block.Typ,SubType,true,false);
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent searched examples for exact match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
    {$ENDIF}
    if CheckPolicies(ExamplePolicies,Result,false) then exit;

    if Policies<>nil then begin
      // check current source for any match
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent check current source for any match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
      {$ENDIF}
      if CheckPolicies(Policies,Result,true) then exit;
    end;

    // parse examples for any match
    ExamplePolicies:=FindPolicyInExamples(nil,Block.Typ,SubType,true,true);
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent searching examples for any match: context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
    {$ENDIF}
    if CheckPolicies(ExamplePolicies,Result,true) then exit;

  finally
    Stack.Free;
    if Policies<>nil then
      FreeAndNil(Policies.Code);
    Policies.Free;
  end;

  {$IFDEF VerboseIndenter}
  DebugLn(['TFullyAutomaticBeautifier.GetIndent no example found : context=',EnumToStr(Block.Typ),'/',EnumToStr(SubType),' contextindent=',GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth)]);
  {$ENDIF}
  if SubTypeValid then
    GetDefaultIndentPolicy(Block.Typ,SubType,Indent)
  else
    GetDefaultIndentPolicy(Block.Typ,bbtNone,Indent);
  if Indent.IndentValid then begin
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent using default ',Indent.Indent]);
    {$ENDIF}
    inc(Indent.Indent,GetLineIndentWithTabs(Source,Block.StartPos,DefaultTabWidth));
    Result:=true;
  end;
end;

function TFullyAutomaticBeautifier.GetIndents(const Source: string;
  Positions: TFABPositionIndents; NewNestedComments: boolean;
  UseLineStart: boolean; ContextLearn: boolean): boolean;
var
  Needed: LongInt;

  function CheckPolicies(Policies: TFABPolicies;
    Item: PFABPositionIndent): boolean;
  // returns true to stop searching
  var
    BlockIndent: LongInt;
  begin
    Result:=false;
    if (Policies=nil) then exit;
    if Item^.SubTypeValid then
      BlockIndent:=Policies.GetIndent(Item^.Block.Typ,Item^.SubType,true,true)
    else
      BlockIndent:=Policies.GetSmallestIndent(Item^.Block.Typ);
    if (BlockIndent<0) then exit;
    // policy found
    {$IFDEF VerboseIndenter}
    DebugLn(['TFullyAutomaticBeautifier.GetIndent policy found: Block.Typ=',EnumToStr(Item^.Block.Typ),' BlockIndent=',BlockIndent]);
    {$ENDIF}
    Item^.Indent.Indent:=GetLineIndentWithTabs(Source,Item^.Block.StartPos,DefaultTabWidth)
                   +BlockIndent;
    Item^.Indent.IndentValid:=true;
    dec(Needed);
    Result:=Needed=0;
  end;

var
  Item: PFABPositionIndent;
  ItemIndex: Integer;
  LastAtomStart, LastAtomEnd: integer;
  Stack: TFABBlockStack;
  StackIndex: LongInt;
  Policies: TFABPolicies;
begin
  Result:=false;
  if (Positions=nil) or (Positions.Count=0) then exit;
  Needed:=Positions.Count;
  for ItemIndex:=0 to Positions.Count-1 do begin
    Item:=@Positions.Items[ItemIndex];
    Item^.CleanPos:=FindStartOfAtom(Source,Item^.CleanPos);
    if Item^.CleanPos<1 then exit;
    FillByte(Item^.Indent,SizeOf(Item^.Indent),0);
    if (ItemIndex>0)
    and (Item^.CleanPos<=Positions.Items[ItemIndex-1].CleanPos) then
      exit;
    Item^.Block:=CleanBlock;
    Item^.SubType:=bbtNone;
    Item^.SubTypeValid:=false;
  end;

  if UseLineStart then begin
    Item:=@Positions.Items[0];
    while (Item^.CleanPos<=length(Source))
    and (Source[Item^.CleanPos] in [' ',#9]) do
      inc(Item^.CleanPos);
  end;

  Policies:=nil;
  Stack:=TFABBlockStack.Create;
  try
    if ContextLearn then
      Policies:=TFABPolicies.Create;
    {$IFDEF ShowCodeBeautifierLearn}
    Policies.Code:=TCodeBuffer.Create;
    Policies.Code.Source:=Source;
    {$ENDIF}
    for ItemIndex:=0 to Positions.Count-1 do begin
      Item:=@Positions.Items[ItemIndex];
      if ItemIndex=0 then begin
        // parse source in front
        {$IFDEF VerboseIndenter}
        DebugLn(['TFullyAutomaticBeautifier.GetIndent Index=',ItemIndex,' "',dbgstr(copy(Source,Item^.CleanPos-10,10)),'|',dbgstr(copy(Source,Item^.CleanPos,10)),'"']);
        {$ENDIF}
        ParseSource(Source,1,Item^.CleanPos,NewNestedComments,Stack,Policies,
                    LastAtomStart,LastAtomEnd);
      end else begin
        // parse to next position
        ParseSource(Source,Positions.Items[ItemIndex-1].CleanPos,
                    Item^.CleanPos,NewNestedComments,Stack,nil,
                    LastAtomStart,LastAtomEnd);
      end;
      {$IFDEF VerboseIndenter}
      WriteDebugReport('After parsing code: ',Stack);
      {$ENDIF}
      if (LastAtomStart>0) and (Item^.CleanPos>LastAtomStart) then begin
        // in comment or atom
        {$IFDEF VerboseIndenter}
        DebugLn(['TFullyAutomaticBeautifier.GetIndent Index=',ItemIndex,' parsed code in front: position in middle of atom, e.g. comment']);
        {$ENDIF}
        GetDefaultSrcIndent(Source,Item^.CleanPos,NewNestedComments,Item^.Indent);
        if Item^.Indent.IndentValid then begin
          dec(Needed);
          if Needed=0 then exit;
        end;
      end;
      if not Item^.Indent.IndentValid then begin
        if LastAtomStart>0 then Item^.CleanPos:=LastAtomStart;

        Item^.SubType:=bbtNone;
        Item^.SubTypeValid:=false;
        if UseLineStart then
          StackIndex:=AdjustByNextAtom(Source,Item^.CleanPos,
                      NewNestedComments,Stack,Item^.SubType,Item^.SubTypeValid);
        if (StackIndex<0) then begin
          // no context
          {$IFDEF VerboseIndenter}
          DebugLn(['TFullyAutomaticBeautifier.GetIndent Index=',ItemIndex,' parsed code in front: no context']);
          {$ENDIF}
          GetDefaultSrcIndent(Source,Item^.CleanPos,NewNestedComments,Item^.Indent);
          if Item^.Indent.IndentValid then begin
            dec(Needed);
            if Needed=0 then exit(true);
          end;
        end;
      end;
      StackIndex:=Stack.Top;
      if not Item^.Indent.IndentValid then begin
        if StackIndex=0 then begin
          dec(Needed);
          if Needed=0 then exit(true);
        end else begin
          Item^.Block:=Stack.Stack[StackIndex];
          {$IFDEF VerboseIndenter}
          DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed code in front: context=',EnumToStr(Item^.Block.Typ),'/',EnumToStr(Item^.SubType),' indent=',GetLineIndentWithTabs(Source,Item^.Block.StartPos,DefaultTabWidth)]);
          {$ENDIF}
          if CheckPolicies(Policies,Item) then exit(true);
        end;
      end;
    end;

    if Policies<>nil then begin
      // parse source behind
      ParseSource(Source,Item^.CleanPos,length(Source)+1,NewNestedComments,
                  Stack,Policies,false);
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed source behind']);
      {$ENDIF}
      for ItemIndex:=0 to Positions.Count-1 do begin
        Item:=@Positions.Items[ItemIndex];
        if (not Item^.Indent.IndentValid) and (Item^.Block.Typ<>bbtNone) then
          if CheckPolicies(Policies,Item) then exit(true);
      end;
    end;
  finally
    Stack.Free;
    if Policies<>nil then
      FreeAndNil(Policies.Code);
    Policies.Free;
  end;

  // parse examples
  for ItemIndex:=0 to Positions.Count-1 do begin
    Item:=@Positions.Items[ItemIndex];
    if (not Item^.Indent.IndentValid) and (Item^.Block.Typ<>bbtNone) then begin
      Policies:=FindPolicyInExamples(nil,Item^.Block.Typ,Item^.SubType,true,true);
      {$IFDEF VerboseIndenter}
      DebugLn(['TFullyAutomaticBeautifier.GetIndent parsed examples']);
      {$ENDIF}
      if (Policies<>nil) and CheckPolicies(Policies,Item) then
        exit(true);
    end;
  end;
end;

procedure TFullyAutomaticBeautifier.GetDefaultSrcIndent(const Source: string;
  CleanPos: integer; NewNestedComments: boolean; out
  Indent: TFABIndentationPolicy);
// return indent of last non empty line
begin
  Indent.Indent:=0;
  Indent.IndentValid:=false;
  // go to start of line
  while (CleanPos>1) and (not (Source[CleanPos-1] in [#10,#13])) do
    dec(CleanPos);
  while CleanPos>1 do begin
    // skip line end
    dec(CleanPos);
    if (CleanPos>1) and (Source[CleanPos-1] in [#10,#13])
    and (Source[CleanPos]<>Source[CleanPos-1]) then
      dec(CleanPos);
    // read line
    while (CleanPos>1) do begin
      case Source[CleanPos-1] of
      ' ',#9: dec(CleanPos);
      #10,#13:
        begin
          // empty line
          break;
        end;
      else
        dec(CleanPos);
        Indent.Indent:=GetLineIndentWithTabs(Source,CleanPos,DefaultTabWidth);
        Indent.IndentValid:=true;
        exit;
      end;
      dec(CleanPos);
    end;
  end;
  // only empty lines in front
end;

procedure TFullyAutomaticBeautifier.GetDefaultIndentPolicy(Typ,
  SubTyp: TFABBlockType; out Indent: TFABIndentationPolicy);
begin
  Indent.IndentValid:=false;
  Indent.Indent:=0;
  case Typ of
  bbtInterface,
  bbtImplementation,
  bbtInitialization,
  bbtFinalization,
  bbtClass,
  bbtClassInterface,
  bbtProcedure,
  bbtFunction,
  bbtCaseOf,
  bbtCaseLabel,
  bbtIf:
    begin
      Indent.Indent:=0;
      Indent.IndentValid:=true;
    end;
  bbtUsesSection,
  bbtTypeSection,
  bbtConstSection,
  bbtVarSection,
  bbtResourceStringSection,
  bbtLabelSection,
  bbtDefinition,
  bbtRecord,
  bbtClassSection,
  bbtMainBegin,
  bbtFreeBegin,
  bbtRepeat,
  bbtForDo,
  bbtProcedureBegin,
  bbtCase,
  bbtCaseColon,
  bbtCaseElse,
  bbtTry,
  bbtFinally,
  bbtExcept,
  bbtIfBegin:
    begin
      Indent.Indent:=2;
      Indent.IndentValid:=true;
    end;
  bbtIfThen,
  bbtIfElse:
    if SubTyp=bbtIfBegin then begin
      Indent.Indent:=0;
      Indent.IndentValid:=true;
    end else begin
      Indent.Indent:=2;
      Indent.IndentValid:=true;
    end;
  end;
end;

{ TFABPolicies }

function TFABPolicies.FindIndentation(Typ, SubType: TFABBlockType;
  out InsertPos: integer): boolean;
// binary search
var
  l: Integer;
  r: Integer;
  m: Integer;
  Ind: PFABFoundIndentationPolicy;
begin
  l:=0;
  r:=IndentationCount-1;
  while l<=r do begin
    m:=(l+r) div 2;
    Ind:=@Indentations[m];
    if (Typ<Ind^.Typ) then
      r:=m-1
    else if (Typ>Ind^.Typ) then
      l:=m+1
    else if SubType<Ind^.SubTyp then
      r:=m-1
    else if SubType>Ind^.SubTyp then
      l:=m+1
    else begin
      InsertPos:=m;
      exit(true);
    end;
  end;
  Result:=false;
  if IndentationCount=0 then
    InsertPos:=0
  else if r<m then
    InsertPos:=m
  else
    InsertPos:=m+1;
end;

constructor TFABPolicies.Create;
begin

end;

destructor TFABPolicies.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TFABPolicies.Clear;
begin
  IndentationCount:=0;
  ReAllocMem(Indentations,0);
  IndentationCapacity:=0;
end;

procedure TFABPolicies.AddIndent(Typ, SubType: TFABBlockType;
  SrcPos, Indent: integer);
var
  i: Integer;
  Ind: PFABFoundIndentationPolicy;
begin
  if not FindIndentation(Typ,SubType,i) then begin
    inc(IndentationCount);
    if IndentationCount>IndentationCapacity then begin
      IndentationCapacity:=IndentationCapacity*2+12;
      ReAllocMem(Indentations,SizeOf(TFABFoundIndentationPolicy)*IndentationCapacity);
    end;
    if i<IndentationCount-1 then
      System.Move(Indentations[i],Indentations[i+1],
        SizeOf(TFABFoundIndentationPolicy)*(IndentationCount-i-1));
    Ind:=@Indentations[i];
    Ind^.Typ:=Typ;
    Ind^.SubTyp:=SubType;
    Ind^.Indent:=Indent;
    {$IFDEF StoreLearnedPositions}
    Ind^.SrcPos:=SrcPos;
    {$ENDIF}
    {$IFDEF ShowCodeBeautifierLearn}
    DebugLn(['TFABPolicies.AddIndent New SubTyp ',EnumToStr(Typ),'-',EnumToStr(SubType),': indent=',Indent,' ',CodePosToStr(SrcPos)]);
    ConsistencyCheck;
    {$ENDIF}
  end else begin
    Ind:=@Indentations[i];
    if Ind^.Indent<>Indent then begin
      Ind^.Indent:=Indent;
      {$IFDEF ShowCodeBeautifierLearn}
      DebugLn(['TFABPolicies.AddIndent Changed SubTyp ',EnumToStr(Typ),'-',EnumToStr(SubType),': indent=',Indent,' ',CodePosToStr(SrcPos)]);
      {$ENDIF}
    end;
  end;
end;

function TFABPolicies.GetSmallestIndent(Typ: TFABBlockType): integer;
var
  i: Integer;
begin
  Result:=High(integer);
  for i:=0 to IndentationCount-1 do begin
    if (Indentations[i].Typ<>Typ) or (Indentations[i].Indent<0) then continue;
    {$IFDEF VerboseIndenter}
    debugln(['TFABPolicies.GetSmallestIndent ',EnumToStr(Indentations[i].Typ),'/',EnumToStr(Indentations[i].SubTyp),' Indent=',Indentations[i].Indent
      {$IFDEF StoreLearnedPositions}
      ,' SrcPos=',CodePosToStr(Indentations[i].SrcPos)
      {$ENDIF}
      ]);
    {$ENDIF}
    if Indentations[i].Indent<Result then
      Result:=Indentations[i].Indent;
  end;
  if Result=High(integer) then
    Result:=-1;
end;

function TFABPolicies.GetIndent(Typ, SubType: TFABBlockType;
  UseNoneIfNotFound, UseSmallestIfNotFound: boolean): integer;
var
  i: integer;
begin
  if FindIndentation(Typ,SubType,i) then begin
    Result:=Indentations[i].Indent;
    {$IFDEF VerboseIndenter}
    debugln(['TFABPolicies.GetIndent ',EnumToStr(Typ),'/',EnumToStr(SubType),' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
    {$ENDIF}
  end else if UseNoneIfNotFound and FindIndentation(Typ,bbtNone,i) then begin
    Result:=Indentations[i].Indent;
    {$IFDEF VerboseIndenter}
    debugln(['TFABPolicies.GetIndent ',EnumToStr(Typ),'/',EnumToStr(bbtNone),' learned at ',CodePosToStr(Indentations[i].SrcPos),' Result=',Result]);
    {$ENDIF}
  end else if UseSmallestIfNotFound then
    Result:=GetSmallestIndent(Typ)
  else
    Result:=-1;
end;

function TFABPolicies.CodePosToStr(p: integer): string;
var
  Line: integer;
  Col: integer;
begin
  if Code<>nil then begin
    Code.AbsoluteToLineCol(p,Line,Col);
    Result:='('+IntToStr(Line)+','+IntToStr(Col)+')';
  end else begin
    Result:='(p='+IntToStr(p)+')';
  end;
end;

procedure TFABPolicies.ConsistencyCheck;

  procedure Error;
  begin
    WriteDebugReport;
    RaiseCatchableException('');
  end;

var
  i: Integer;
  Ind1: PFABFoundIndentationPolicy;
  Ind2: PFABFoundIndentationPolicy;
  InsertPos: integer;
begin
  for i:=0 to IndentationCount-1 do begin
    Ind1:=@Indentations[i];
    if Ind1^.Indent=High(Ind1^.Indent) then
      Error;
    if Ind1^.Indent<0 then
      Error;
    if i<IndentationCount-1 then begin
      // check for duplicates and sorted
      Ind2:=@Indentations[i+1];
      if Ind1^.Typ>Ind2^.Typ then
        Error;
      if Ind1^.Typ=Ind2^.Typ then begin
        if Ind1^.SubTyp>=Ind2^.SubTyp then
          Error;
      end;
    end;
    if not FindIndentation(Ind1^.Typ,Ind1^.SubTyp,InsertPos) then
      Error;
    if InsertPos<>i then
      Error;
  end;
end;

procedure TFABPolicies.WriteDebugReport;
var
  i: Integer;
  Ind: PFABFoundIndentationPolicy;
begin
  debugln(['TFABPolicies.WriteDebugReport ']);
  for i:=0 to IndentationCount-1 do begin
    Ind:=@Indentations[i];
    debugln(['  ',i,'/',IndentationCount,' ',EnumToStr(Ind^.Typ),'=',ord(Ind^.Typ),' ',EnumToStr(Ind^.SubTyp),'=',ord(Ind^.SubTyp),' Indent=',Ind^.Indent]);
  end;
end;

{ TFABPositionIndents }

procedure TFABPositionIndents.SetCount(const AValue: integer);
begin
  if FCount=AValue then exit;
  ReAllocMem(Items,SizeOf(TFABPositionIndent)*AValue);
  if AValue>FCount then
    FillByte(Items[FCount],SizeOf(TFABPositionIndent)*(AValue-FCount),0);
  FCount:=AValue;
end;

constructor TFABPositionIndents.Create;
begin

end;

destructor TFABPositionIndents.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TFABPositionIndents.Clear;
begin
  Count:=0;
end;

end.