lazarus/components/jcf2/Process/Indent/Indenter.pas
2018-11-23 17:38:31 +00:00

738 lines
20 KiB
ObjectPascal

unit Indenter;
{(*}
(*------------------------------------------------------------------------------
Delphi Code formatter source code
The Original Code is Indenter, released May 2003.
The Initial Developer of the Original Code is Anthony Steele.
Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
All Rights Reserved.
Contributor(s): Anthony Steele.
The contents of this file are subject to the Mozilla Public License Version 1.1
(the "License"). you may not use this file except in compliance with the License.
You may obtain a copy of the License at http://www.mozilla.org/NPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied.
See the License for the specific language governing rights and limitations
under the License.
Alternatively, the contents of this file may be used under the terms of
the GNU General Public License Version 2 or later (the "GPL")
See http://www.gnu.org/licenses/gpl.html
------------------------------------------------------------------------------*)
{*)}
{$I JcfGlobal.inc}
interface
{ AFS 23 Feb 2003
process to indent tokens
Will borrow some old code, but mostly new
This is the single most important (and possibly most complex)
of all the processes
it sets the indent for the start of the line
}
uses SwitchableVisitor;
type
TIndenter = class(TSwitchableVisitor)
protected
function EnabledVisitSourceToken(const pcNode: TObject): Boolean; override;
public
constructor Create; override;
end;
implementation
uses
{ delphi }
SysUtils,
{ local }
JcfStringUtils,
SourceToken, Nesting, FormatFlags, JcfSettings, TokenUtils,
Tokens, ParseTreeNode, ParseTreeNodeType;
{ true if the specified token type occurs before pt on the line }
function HasPreceedingTokenTypeOnLine(const pt: TSourceToken; const ptt: TTokenTypeSet): Boolean;
var
lcTest: TSourceToken;
begin
Result := False;
lcTest := pt;
repeat
lcTest := lcTest.PriorToken;
if lcTest <> nil then
Result := (lcTest.TokenType in ptt);
until Result or (lcTest = nil) or (lcTest.TokenType = ttReturn);
end;
function HasPreceedingSolidToken(const pt: TSourceToken): Boolean;
var
lcTest: TSourceToken;
begin
Result := False;
lcTest := pt;
repeat
lcTest := lcTest.PriorToken;
if lcTest <> nil then
Result := lcTest.IsSolid;
until Result or (lcTest = nil) or (lcTest.TokenType = ttReturn);
end;
function HasSolidTokenBeforeUnderSameParent(const pt: TSourceToken): Boolean;
var
lcParent: TParseTreeNode;
liLoop: integer;
begin
Result := False;
lcParent := pt.Parent;
for liLoop := 0 to lcParent.IndexOfChild(pt) do
begin
if lcParent.ChildNodes[liLoop] is TSourceToken then
begin
if TSourceToken(lcParent.ChildNodes[liLoop]).IsSolid then
begin
Result := True;
break;
end;
end;
end;
end;
function InGlobalTypeOrVarOrConstSection(const pt: TSourceToken): Boolean;
begin
// are we in a type or var section?
if not pt.HasParentNode([nTypeSection, nVarSection, nConstSection]) then
begin
Result := False;
exit;
end;
if pt.HasParentNode(MethodDeclarations) then
begin
Result := False;
exit;
end;
Result := True;
end;
function IsIndented(const pt: TSourceToken): Boolean;
begin
Result := IsFirstSolidTokenOnLine(pt);
if Result then
begin
{ don't indent } // when there's a comment before the token on a line
if HasPreceedingTokenTypeOnLine(pt, [ttComment]) then
begin
Result := False;
end;
end
else if IsSingleLineComment(pt) and (pt.CommentStyle <> eCompilerDirective) then
begin
{ if it's a single line comment, with nothing on the line before it
then may want to indent it }
if not HasPreceedingSolidToken(pt) then
begin
if pt.HasParentNode(nBlock) then
begin
Result := FormattingSettings.Indent.KeepCommentsWithCodeInProcs;
end
else if pt.HasParentNode([nClassType, nInterfaceType]) then
begin
Result := FormattingSettings.Indent.KeepCommentsWithCodeInClassDef;
end
else if pt.HasParentNode([nDeclSection]) then
Result := FormattingSettings.Indent.KeepCommentsWithCodeInGlobals
else
Result := FormattingSettings.Indent.KeepCommentsWithCodeElsewhere;
end;
end;
end;
{ is this token in an expression that starts on a previous line }
function IsRunOnExpr(const pt: TSourceToken): boolean;
var
lcExpr: TParseTreeNode;
lcExprStart: TSourceToken;
begin
Result := False;
if pt = nil then
exit;
lcExpr := pt.GetParentNode(nExpression);
if lcExpr <> nil then
begin
lcExprStart := lcExpr.FirstLeaf as TSourceToken;
while (lcExprStart <> nil) and ( not lcExprStart.IsSolid) do
lcExprStart := lcExprStart.NextToken;
if lcExprStart.YPosition < pt.YPosition then
Result := True;
end;
end;
function IsInAssignExpr(const pt: TSourceToken): boolean;
begin
Result := False;
if pt = nil then
exit;
if not pt.HasParentNode(nAssignment) then
exit;
if not pt.IsOnRightOf([nAssignment], AssignmentDirectives) then
exit;
Result := True;
end;
function IsInProcedureParams(const pt: TSourceToken): boolean;
begin
Result := False;
if pt = nil then
exit;
if not pt.HasParentNode(nActualParams) then
exit;
if pt.Nestings.GetLevel(nlRoundBracket) = 0 then
exit;
// in a statement, in round brackets, also need .. ??
Result := True;
end;
{ this is needed for nested types
indent the inner class more than the outer }
function CountClassNesting(const pt: TParseTreeNode): integer;
begin
Result := 0;
if pt = nil then
exit;
if pt.NodeType in ObjectTypes then
Result := 1;
Result := Result + CountClassNesting(pt.Parent);
end;
function CountTypeNesting(const pt: TParseTreeNode): integer;
begin
Result := 0;
if pt = nil then
exit;
if pt.NodeType = nTypeSection then
Result := 1;
Result := Result + CountTypeNesting(pt.Parent);
end;
function IsRunOnProcDecl(const pt: TSourceToken): boolean;
begin
Result := pt.HasParentNode(ProcedureHeadings) and
(not (pt.TokenType in (ProcedureWords + [ttClass, ttComment])));
end;
{ true if this is the top of an if statement
would be easier if there was a nIfStatement node type }
function IsIfBlockTop(const pn: TParseTreeNode): boolean;
var
lcToken: TSourceToken;
begin
Result := False;
if pn.IsLeaf then
begin
lcToken := TSourceToken(pn);
Result := (lcToken.TokenType in [ttIf, ttElse]);
end;
if not Result then
Result := (pn.NodeType in [nIfBlock, nIfCondition]);
if not Result then
Result := (pn.NodeType = nStatement) and (pn.HasChildNode(ttIf, 1));
end;
function ElseDepth(const pt: TSourceToken): integer;
var
lcParent: TParseTreeNode;
begin
Result := 0;
if InStatements(pt) then
begin
lcParent := pt;
while (lcParent <> nil) do
begin
// increment for an if statement under an else
if IsIfblockTop(lcParent) and lcParent.HasParentNode(nElseBlock, 2) then
begin
inc(Result);
// skip the next two level, part of the same if-else block.
if lcParent.NodeType <> nStatement then
lcParent := lcParent.Parent;
if lcParent <> nil then
lcParent := lcParent.Parent;
end;
if lcParent <> nil then
lcParent := lcParent.Parent;
end;
end;
end;
function CalculateIndent(const pt: TSourceToken): integer;
var
liIndentCount: integer;
lbHasIndentedRunOnLine: boolean;
lbHasIndentedDecl: boolean;
lcParent, lcChild: TParseTreeNode;
liClassNestingCount: integer;
liTypeNestingCount: integer;
liVarConstIndent: integer;
begin
Result := 0;
lbHasIndentedRunOnLine := False;
lbHasIndentedDecl := False;
if pt = nil then
exit;
{ object types }
if pt.HasParentNode(ObjectTypes) then
begin
{ indentation sections inside the class }
if FormattingSettings.Indent.IndentVarAndConstInClass then
begin
liVarConstIndent := 2;
end
else
begin
liVarConstIndent := 1;
end;
if pt.TokenType in ClassVisibility + [ttStrict] then
liIndentCount := 1
else if (pt.TokenType = ttConst) and pt.HasParentNode(nConstSection, 1) then
liIndentCount := liVarConstIndent
else if (pt.TokenType = ttVar) and pt.HasParentNode(nVarSection, 1) then
liIndentCount := liVarConstIndent
else if (pt.TokenType = ttClass) and pt.HasParentNode(nClassVars, 1) then
liIndentCount := 2
else if pt.TokenType = ttEnd then
begin
// end is the end of the class unless it's the end of an anon record typed var
if pt.HasParentNode(nRecordType) then
liIndentCount := 2
else
liIndentCount := 1;
end
else
liIndentCount := 2;
// run on lines in properties
if pt.HasParentNode(nProperty) and (not (pt.TokenType in [ttProperty, ttComment, ttClass])) then
Inc(liIndentCount);
// run on lines in procs
if IsRunOnProcDecl(pt) then
Inc(liIndentCount);
lbHasIndentedDecl := True;
liClassNestingCount := CountClassNesting(pt);
liIndentCount := liIndentCount + (liClassNestingCount - 1);
if FormattingSettings.Indent.IndentNestedTypes then
begin
liTypeNestingCount := CountTypeNesting(pt);
if (liTypeNestingCount > 1) then
begin
if pt.TokenType = ttType then
begin
liIndentCount := liIndentCount + (liTypeNestingCount - 2);
end
else
begin
liIndentCount := liIndentCount + (liTypeNestingCount - 1);
end;
end;
end;
end
{ indent vars, consts etc, e.g.
implementation
co nst
foo = 3;
v ar
bar: integer;
}
else if pt.HasParentNode(nDeclSection) and (not pt.HasParentNode(ProcedureNodes)) then
begin
if pt.TokenType in Declarations + ProcedureWords then
begin
{
the words 'var' and 'const' can be found in proc params
the words 'procedure' and 'function' can be found in type defs, e.g. type Tfoo = procedure of object; }
if (pt.TokenType in ProcedureWords + ParamTypes) and
(pt.HasParentNode(nProcedureType) or pt.HasParentNode(nFormalParams)) then
liIndentCount := 1
else
liIndentCount := 0;
end
else
liIndentCount := 1;
if pt.Nestings.GetLevel(nlProcedure) > 1 then
liIndentCount := liIndentCount + (pt.Nestings.GetLevel(nlProcedure) - 1);
end
else
begin
{ this section is for
- procedure body
- procedure declarations
}
{ indent procedure body for various kinds of block }
liIndentCount := pt.Nestings.GetLevel(nlBlock);
if liIndentCount > 0 then
begin
// outdent keywords that start and end the block
if pt.TokenType in BlockOutdentWords then
begin
Dec(liIndentCount);
// not these in local record type decl
if (pt.TokenType in [ttCase, ttEnd]) and (pt.HasParentNode(nRecordType)) then
Inc(liIndentCount);
// not these in procedure params or procedure type
if (pt.TokenType in ParamTypes) and pt.HasParentNode(nProcedureType) then
Inc(liIndentCount);
end
end;
{ procedure formal params are not in the block }
if pt.HasParentNode(nFormalParams) then
Inc(liIndentCount);
if (liIndentCount = 0) and pt.HasParentNode(nProcedureDirectives) then
liIndentCount := 1;
// else as an outdent for an exception block
if (pt.TokenType = ttElse) and pt.HasParentNode(nOnExceptionHandler, 1) then
Dec(liIndentCount);
// while loop (and others?) expression is not yet in the block
if pt.HasParentNode([nLoopHeaderExpr, nBlockHeaderExpr]) then
begin
//dec(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
if pt.Nestings.GetLevel(nlCaseSelector) > 0 then
begin
liIndentCount := liIndentCount + pt.Nestings.GetLevel(nlCaseSelector);
// don't indent the case label again
if pt.HasParentNode(nCaseLabel, 6) then
Dec(liIndentCount)
else if (pt.TokenType in [ttElse, ttOtherwise]) and pt.HasParentNode(nElseCase, 1) then
Dec(liIndentCount);
if not FormattingSettings.Indent.IndentCaseElse then
begin
liIndentCount := liIndentCount - pt.CountParentNodes(nElseCase);
end;
end;
{ nested procedures
if pt.Nestings.GetLevel(nlProcedure) > 1 then
liIndentCount := liIndentCount + (pt.Nestings.GetLevel(nlProcedure) - 1);
}
if pt.HasParentNode(nAsm) and pt.HasParentNode(nStatementList) then
Inc(liIndentCount);
{ indent for run on line }
if pt.HasParentNode(nStatement) and (pt.Nestings.GetLevel(nlRoundBracket) +
(pt.Nestings.GetLevel(nlSquareBracket)) > 0) then
begin
Inc(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
// indent for uses clause
if pt.HasParentNode(UsesClauses) and ( not (pt.TokenType in UsesWords)) then
begin
Inc(liIndentCount);
{ run on uses item }
if pt.HasParentNode(nUsesItem, 1) and (pt.IsOnRightOf(nUsesItem, ttIn)) then
Inc(liIndentCount);
end;
if (pt.TokenType = ttOn) and pt.HasParentNode(nOnExceptionHandler, 1) then
Dec(liIndentCount);
{ run on lines such as
SomeArray[
index] := 3; }
if ( not lbHasIndentedRunOnLine) and pt.HasParentNode(nDesignator) and
(pt.TokenType <> ttComment) then
begin
lcParent := pt.Parent;
if lcParent.NodeType = nIdentifier then
lcParent := lcParent.Parent;
lcChild := lcParent.FirstSolidLeaf;
if (pt <> lcChild) then
begin
Inc(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
end;
if FormattingSettings.Indent.IndentElse then
liIndentCount := liIndentCount + ElseDepth(pt);
end; // procedures
{ record declaration stuph }
if pt.HasParentNode(nRecordType) then
begin
{ nested record types }
if pt.Nestings.GetLevel(nlRecordType) > 1 then
liIndentCount := liIndentCount + (pt.Nestings.GetLevel(nlRecordType) - 1);
if pt.Nestings.GetLevel(nlRecordVariantSection) > 0 then
begin
liIndentCount := liIndentCount + pt.Nestings.GetLevel(nlRecordVariantSection);
if pt.TokenType = ttCase then
Dec(liIndentCount);
end;
if pt.HasParentNode(nRecordVariant) and (RoundBracketLevel(pt) > 0) then
Inc(liIndentCount);
// delphi.net fns and procedures in records
if pt.TokenType in (ProcedureWords) then
begin
Inc(liIndentCount);
end
// class procs, but not class vars - those are already done
else if (pt.TokenType = ttClass) then
begin
if not pt.HasParentNode(nClassVars, 1) then
begin
Inc(liIndentCount);
end;
end;
if (pt.TokenType <> ttEnd) then
begin
lbHasIndentedDecl := True;
if not (pt.TokenType in ClassVisibility) then
Inc(liIndentCount);
end;
// run on lines in procs
if pt.HasParentNode(ProcedureHeadings) and
( not (pt.TokenType in (ProcedureWords + [ttClass, ttComment]))) then
Inc(liIndentCount);
if IsRunOnProcDecl(pt) then
Inc(liIndentCount);
end;
{ these apply everywhere
mostly because they need to apply to decls
either in or out of a proc }
if pt.HasParentNode(nEnumeratedType) and (RoundBracketLevel(pt) > 0) then
begin
Inc(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
// indent for run-on const decl
if ( not lbHasIndentedRunOnLine) and
pt.HasParentNode(nConstDecl) and pt.IsOnRightOf(nConstDecl, ttEquals) then
begin
Inc(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
// indent for the type decl in a const
if ( not lbHasIndentedRunOnLine) and
pt.HasParentNode(nConstDecl) and pt.IsOnRightOf(nConstDecl, ttColon) and
pt.HasParentNode(nType) then
begin
Inc(liIndentCount);
lbHasIndentedRunOnLine := True;
end;
{ run on expression }
if not lbHasIndentedRunOnLine then
begin
if IsRunOnExpr(pt) then
Inc(liIndentCount)
else if IsInAssignExpr(pt) then
Inc(liIndentCount)
else if IsInProcedureParams(pt) then
Inc(liIndentCount)
{ run-on type decl }
else if pt.IsOnRightOf(nTypeDecl, ttEquals) and ( not lbHasIndentedDecl) and
(pt.TokenType <> ttEnd) then
Inc(liIndentCount);
end;
if ( not lbHasIndentedRunOnLine) and pt.HasParentNode(nArrayConstant) and
((RoundBracketLevel(pt) > 0) or (pt.TokenType in
[ttOpenBracket, ttCloseBracket])) then
Inc(liIndentCount);
// indent statement after label
if ( not lbHasIndentedRunOnLine) and
(pt.Nestings.GetLevel(nlStatementLabel) > 0) and
( not pt.HasParentNode(nStatementLabel)) then
Inc(liIndentCount);
// program or library top level procs
// re bug 1898723 - Identination of procedures in library
if not FormattingSettings.Indent.IndentLibraryProcs then
begin
if pt.HasParentNode([nLibrary, nProgram]) and (liIndentCount >= 1) then
begin
if not pt.HasParentNode([nExports, nUses]) and (not InGlobalTypeOrVarOrConstSection(pt)) then
begin
if pt.HasParentNode([nCompoundStatement]) and not pt.HasParentNode([nDeclSection]) then
begin
// this is the program/lib main code block
// it's flush left already
end
else
begin
Dec(liIndentCount);
end;
end;
end;
end;
// indent all of procs except for the first line
if FormattingSettings.Indent.IndentProcedureBody then
begin
if pt.HasParentNode(MethodDeclarations) then
begin
if not (pt.HasParentNode(MethodHeadings)) then
begin
inc(liIndentCount);
end;
end;
end;
Assert(liIndentCount >= 0, 'Indent count = ' + IntToStr(liIndentCount) +
' for ' + pt.Describe);
Result := FormattingSettings.Indent.SpacesForIndentLevel(liIndentCount);
// asm extra indent
if IsInsideAsm(pt) and FormattingSettings.SetAsm.StatementIndentEnabled then
begin
Result := Result + FormattingSettings.SetAsm.StatementIndent;
end;
// IndentBeginEnd option to indent begin/end words a bit extra
if FormattingSettings.Indent.IndentBeginEnd then
begin
if (pt.TokenType in [ttTry, ttExcept, ttFinally, ttBegin, ttEnd]) and InStatements(pt) then
begin
// filter out the begin/end that starts and ends a procedure
if not pt.HasParentNode(nBlock, 2) then
begin
Result := Result + FormattingSettings.Indent.IndentBeginEndSpaces;
end;
end;
end;
end;
constructor TIndenter.Create;
begin
inherited;
FormatFlags := FormatFlags + [eIndent];
end;
function TIndenter.EnabledVisitSourceToken(const pcNode: TObject): Boolean;
var
lcSourceToken: TSourceToken;
lcPrev: TSourceToken;
liPos: integer;
liDesiredIndent: integer;
begin
Result := False;
lcSourceToken := TSourceToken(pcNode);
if IsIndented(lcSourceToken) then
begin
liDesiredIndent := CalculateIndent(lcSourceToken);
liPos := lcSourceToken.XPosition - 1;
Assert(liPos >= 0);
if liDesiredIndent < liPos then
begin
{ delete some spaces before, if they exist }
lcPrev := lcSourceToken.PriorToken;
if (lcPrev <> nil) and (lcPrev.TokenType = ttWhiteSpace) then
begin
lcPrev.SourceCode :=
StrRepeat(NativeSpace, liDesiredIndent - lcPrev.XPosition + 1);
end;
{
else if liDesiredIndent > 0 then
begin
// no prev space token? Insert one
prVisitResult.Action := aInsertBefore;
prVisitResult.NewItem := NewSpace(liDesiredIndent);
end;
}
end
else if liDesiredIndent > liPos then
begin
Result := True;
InsertTokenBefore(lcSourceToken, NewSpace(liDesiredIndent - liPos));
end;
end;
end;
end.