paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 05:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: auto indent: proc heads, proc types, definitions

Browse Source 
git-svn-id: trunk@22384 -
This commit is contained in:
mattias 2009-11-02 13:43:14 +00:00
parent fd28119606
commit 1c5d19d57b
1 changed files with 140 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
components/codetools/codebeautifier.pas
View File

@ -103,6 +103,7 @@ type
bbtVarSection, bbtVarSection,
bbtResourceStringSection, bbtResourceStringSection,
bbtLabelSection, bbtLabelSection,
bbtDefinition, // child of bbtTypeSection,bbtConstSection,bbtVarSection,bbtResourceStringSection,bbtLabelSection
// type blocks // type blocks
bbtRecord, bbtRecord,
bbtClass, bbtClass,
@ -113,8 +114,9 @@ type
// statement blocks // statement blocks
bbtProcedure, // procedure, constructor, destructor bbtProcedure, // procedure, constructor, destructor
bbtFunction, // function, operator bbtFunction, // function, operator
bbtProcedureParamList, // child of bbtProcedure or bbtFunction bbtProcedureHead, // child of bbtProcedure or bbtFunction
bbtProcedureModifiers, // child of bbtProcedure or bbtFunction bbtProcedureParamList, // child of bbtProcedureHead
bbtProcedureModifiers, // child of bbtProcedureHead
bbtProcedureBegin, // child of bbtProcedure or bbtFunction bbtProcedureBegin, // child of bbtProcedure or bbtFunction
bbtMainBegin, bbtMainBegin,
bbtFreeBegin, // begin without need (e.g. without if-then) bbtFreeBegin, // begin without need (e.g. without if-then)
@ -164,6 +166,7 @@ const
'bbtVarSection', 'bbtVarSection',
'bbtResourceStringSection', 'bbtResourceStringSection',
'bbtLabelSection', 'bbtLabelSection',
'bbtDefinition',
// type blocks // type blocks
'bbtRecord', 'bbtRecord',
'bbtClass', 'bbtClass',
@ -174,6 +177,7 @@ const
// statement blocks // statement blocks
'bbtProcedure', 'bbtProcedure',
'bbtFunction', 'bbtFunction',
'bbtProcedureHead',
'bbtProcedureParamList', 'bbtProcedureParamList',
'bbtProcedureModifiers', 'bbtProcedureModifiers',
'bbtProcedureBegin', 'bbtProcedureBegin',
@ -529,20 +533,30 @@ var
while Stack.TopType in bbtAllStatements do EndBlock; while Stack.TopType in bbtAllStatements do EndBlock;
end; 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; procedure EndIdentifierSectionAndProc;
begin begin
EndStatements; // fix dangling statements EndStatements; // fix dangling statements
if Stack.TopType=bbtProcedureModifiers then if Stack.TopType=bbtProcedureModifiers then
EndBlock; EndBlock;
if Stack.TopType=bbtProcedureHead then
EndBlock;
if Stack.TopType in bbtAllProcedures then begin if Stack.TopType in bbtAllProcedures then begin
if (Stack.Top=0) or (Stack.Stack[Stack.Top-1].Typ in [bbtImplementation]) if IsProcedureImplementation then begin
then begin
// procedure with begin..end // procedure with begin..end
end else begin end else begin
// procedure without begin..end // procedure without begin..end
EndBlock; EndBlock;
end; end;
end; end;
if Stack.TopType=bbtDefinition then
EndBlock;
if Stack.TopType in bbtAllIdentifierSections then if Stack.TopType in bbtAllIdentifierSections then
EndBlock; EndBlock;
end; end;
@ -556,9 +570,13 @@ var
procedure StartProcedure(Typ: TFABBlockType); procedure StartProcedure(Typ: TFABBlockType);
begin begin
EndIdentifierSectionAndProc; if Stack.TopType<>bbtDefinition then
if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone]) then EndIdentifierSectionAndProc;
if Stack.TopType in (bbtAllCodeSections+bbtAllProcedures+[bbtNone,bbtDefinition])
then begin
BeginBlock(Typ); BeginBlock(Typ);
BeginBlock(bbtProcedureHead);
end;
end; end;
procedure StartClassSection; procedure StartClassSection;
@ -573,6 +591,61 @@ var
BeginBlock(bbtClassSection); BeginBlock(bbtClassSection);
end; 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
EndBlock;
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 var
r: PChar; r: PChar;
Block: PBlock; Block: PBlock;
@ -622,16 +695,13 @@ begin
r:=@Src[AtomStart]; r:=@Src[AtomStart];
if Stack.TopType=bbtProcedureModifiers then begin
// ToDo: check if modifier
EndBlock;
end;
case UpChars[r^] of case UpChars[r^] of
'B': 'B':
if CompareIdentifiers('BEGIN',r)=0 then begin if CompareIdentifiers('BEGIN',r)=0 then begin
while Stack.TopType while Stack.TopType
in (bbtAllIdentifierSections+bbtAllCodeSections+bbtAllBrackets) do in (bbtAllIdentifierSections+bbtAllCodeSections+bbtAllBrackets
+[bbtDefinition,bbtProcedureModifiers,bbtProcedureHead])
do
EndBlock; EndBlock;
case Stack.TopType of case Stack.TopType of
bbtNone: bbtNone:
@ -655,7 +725,7 @@ begin
end; end;
'L': // CL 'L': // CL
if CompareIdentifiers('CLASS',r)=0 then begin if CompareIdentifiers('CLASS',r)=0 then begin
if Stack.TopType=bbtTypeSection then if Stack.TopType=bbtDefinition then
BeginBlock(bbtClass); BeginBlock(bbtClass);
end; end;
'O': // CO 'O': // CO
@ -688,6 +758,10 @@ begin
if CompareIdentifiers('END',r)=0 then begin if CompareIdentifiers('END',r)=0 then begin
// if statements can be closed by end without semicolon // if statements can be closed by end without semicolon
while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do EndBlock; while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do EndBlock;
if Stack.TopType=bbtProcedureModifiers then
EndBlock;
if Stack.TopType=bbtProcedureHead then
EndBlock;
if Stack.TopType in bbtAllProcedures then if Stack.TopType in bbtAllProcedures then
EndBlock; EndBlock;
if Stack.TopType=bbtClassSection then if Stack.TopType=bbtClassSection then
@ -726,11 +800,10 @@ begin
case UpChars[r[1]] of case UpChars[r[1]] of
'I': // FI 'I': // FI
if CompareIdentifiers('FINALIZATION',r)=0 then begin if CompareIdentifiers('FINALIZATION',r)=0 then begin
while Stack.TopType in (bbtAllCodeSections+bbtAllIdentifierSections+bbtAllStatements) while Stack.Top>=0 do
do
EndBlock; EndBlock;
if Stack.TopType=bbtNone then if Stack.TopType=bbtNone then
BeginBlock(bbtInitialization); BeginBlock(bbtFinalization);
end else if CompareIdentifiers('FINALLY',r)=0 then begin end else if CompareIdentifiers('FINALLY',r)=0 then begin
if Stack.TopType=bbtTry then begin if Stack.TopType=bbtTry then begin
EndBlock; EndBlock;
@ -739,9 +812,12 @@ begin
end; end;
'O': // FO 'O': // FO
if CompareIdentifiers('FORWARD',r)=0 then begin if CompareIdentifiers('FORWARD',r)=0 then begin
if Stack.TopType in bbtAllProcedures then begin if Stack.TopType=bbtProcedureModifiers then
EndBlock;
if Stack.TopType=bbtProcedureHead then
EndBlock;
if Stack.TopType in bbtAllProcedures then
EndBlock; EndBlock;
end;
end; end;
'U': // FU 'U': // FU
if CompareIdentifiers('FUNCTION',r)=0 then if CompareIdentifiers('FUNCTION',r)=0 then
@ -759,8 +835,7 @@ begin
case UpChars[r[2]] of case UpChars[r[2]] of
'I': // INI 'I': // INI
if CompareIdentifiers('INITIALIZATION',r)=0 then begin if CompareIdentifiers('INITIALIZATION',r)=0 then begin
while Stack.TopType in (bbtAllCodeSections+bbtAllIdentifierSections+bbtAllStatements) while Stack.Top>=0 do
do
EndBlock; EndBlock;
if Stack.TopType=bbtNone then if Stack.TopType=bbtNone then
BeginBlock(bbtInitialization); BeginBlock(bbtInitialization);
@ -770,15 +845,14 @@ begin
case Stack.TopType of case Stack.TopType of
bbtNone: bbtNone:
BeginBlock(bbtInterface); BeginBlock(bbtInterface);
bbtTypeSection: bbtDefinition:
BeginBlock(bbtClassInterface); BeginBlock(bbtClassInterface);
end; end;
end; end;
end; end;
'M': // IM 'M': // IM
if CompareIdentifiers('IMPLEMENTATION',r)=0 then begin if CompareIdentifiers('IMPLEMENTATION',r)=0 then begin
while Stack.TopType in (bbtAllCodeSections+bbtAllIdentifierSections+bbtAllStatements) while Stack.Top>=0 do
do
EndBlock; EndBlock;
if Stack.TopType=bbtNone then if Stack.TopType=bbtNone then
BeginBlock(bbtImplementation); BeginBlock(bbtImplementation);
@ -857,7 +931,8 @@ begin
end; end;
'Y': // TY 'Y': // TY
if CompareIdentifiers('TYPE',r)=0 then begin if CompareIdentifiers('TYPE',r)=0 then begin
StartIdentifierSection(bbtTypeSection); if Stack.TopType<>bbtDefinition then
StartIdentifierSection(bbtTypeSection);
end; end;
end; end;
'U': 'U':
@ -880,6 +955,8 @@ begin
case Stack.TopType of case Stack.TopType of
bbtUsesSection: bbtUsesSection:
EndBlock; EndBlock;
bbtDefinition:
EndBlock;
bbtCaseColon: bbtCaseColon:
begin begin
EndBlock; EndBlock;
@ -888,8 +965,14 @@ begin
bbtIfThen,bbtIfElse: bbtIfThen,bbtIfElse:
while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do
EndBlock; EndBlock;
bbtProcedure,bbtFunction: bbtProcedureHead:
BeginBlock(bbtProcedureModifiers); if CheckProcedureModifiers then
BeginBlock(bbtProcedureModifiers)
else
EndProcedureHead;
bbtProcedureModifiers:
if not CheckProcedureModifiers then
EndProcedureHead;
end; end;
':': ':':
if p-AtomStart=1 then begin if p-AtomStart=1 then begin
@ -914,7 +997,7 @@ begin
if p-AtomStart=1 then begin if p-AtomStart=1 then begin
// round bracket open // round bracket open
case Stack.TopType of case Stack.TopType of
bbtProcedure,bbtFunction: bbtProcedureHead:
BeginBlock(bbtProcedureParamList); BeginBlock(bbtProcedureParamList);
else else
if Stack.TopType in bbtAllStatements then if Stack.TopType in bbtAllStatements then
@ -950,6 +1033,16 @@ begin
end; end;
end; end;
end; end;
if (Stack.TopType in bbtAllIdentifierSections)
and (IsIdentStartChar[Src[AtomStart]]) then begin
if (CompareIdentifiers('VAR',r)<>0)
and (CompareIdentifiers('TYPE',r)<>0)
and (CompareIdentifiers('CONST',r)<>0)
and (CompareIdentifiers('RESOURCESTRING',r)<>0)
and (CompareIdentifiers('LABEL',r)<>0)
then
BeginBlock(bbtDefinition);
end;
if FirstAtomOnNewLine then begin if FirstAtomOnNewLine then begin
UpdateBlockInnerIndent; UpdateBlockInnerIndent;
@ -1080,12 +1173,16 @@ function TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos(
procedure EndIdentifierSectionAndProc; procedure EndIdentifierSectionAndProc;
begin begin
if Stack.TopType=bbtDefinition then
dec(FindStackPosForBlockCloseAtPos);
if Stack.TopType in bbtAllIdentifierSections then if Stack.TopType in bbtAllIdentifierSections then
dec(FindStackPosForBlockCloseAtPos); dec(FindStackPosForBlockCloseAtPos);
end; end;
procedure StartProcedure; procedure StartProcedure;
begin begin
if Stack.TopType=bbtDefinition then
dec(FindStackPosForBlockCloseAtPos);
if Stack.TopType in bbtAllIdentifierSections then if Stack.TopType in bbtAllIdentifierSections then
dec(FindStackPosForBlockCloseAtPos); dec(FindStackPosForBlockCloseAtPos);
end; end;
@ -1106,8 +1203,7 @@ function TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos(
procedure EndBigSection; procedure EndBigSection;
begin begin
while Stack.TopType in (bbtAllCodeSections+bbtAllIdentifierSections+bbtAllStatements) while Stack.Top>=0 do
do
dec(FindStackPosForBlockCloseAtPos); dec(FindStackPosForBlockCloseAtPos);
end; end;
@ -1125,6 +1221,7 @@ var
r: PChar; r: PChar;
p: LongInt; p: LongInt;
begin begin
DebugLn(['TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos START']);
Result:=Stack.Top; Result:=Stack.Top;
if Result<0 then exit; if Result<0 then exit;
if (CleanPos<1) or (CleanPos>length(Source)) if (CleanPos<1) or (CleanPos>length(Source))
@ -1132,10 +1229,18 @@ begin
exit; exit;
p:=CleanPos; p:=CleanPos;
ReadRawNextPascalAtom(Source,p,AtomStart,NestedComments); ReadRawNextPascalAtom(Source,p,AtomStart,NestedComments);
if AtomStart<>p then exit; DebugLn(['TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos ',AtomStart<>CleanPos,' CleanPos=',dbgstr(copy(Source,CleanPos,10)),' AtomStart=',dbgstr(copy(Source,AtomStart,10))]);
DebugLn(['TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos Atom=',copy(Source,AtomStart,CleanPos-AtomStart)]); if AtomStart<>CleanPos then exit;
DebugLn(['TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos Atom=',copy(Source,AtomStart,p-AtomStart)]);
r:=@Source[AtomStart]; r:=@Source[AtomStart];
case UpChars[r^] of case UpChars[r^] of
'B':
if CompareIdentifiers('BEGIN',r)=0 then begin
if Stack.TopType=bbtDefinition then
dec(FindStackPosForBlockCloseAtPos);
if Stack.TopType in bbtAllIdentifierSections then
dec(FindStackPosForBlockCloseAtPos);
end;
'C': 'C':
if CompareIdentifiers('CONST',r)=0 then if CompareIdentifiers('CONST',r)=0 then
EndIdentifierSectionAndProc; EndIdentifierSectionAndProc;
@ -1156,7 +1261,7 @@ begin
while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do while Stack.TopType in [bbtIf,bbtIfThen,bbtIfElse] do
dec(Result); dec(Result);
if IsMethodDeclaration then if IsMethodDeclaration then
dec(Result,2); dec(Result);
if Stack.TopType=bbtClassSection then if Stack.TopType=bbtClassSection then
dec(Result); dec(Result);
@ -1260,6 +1365,8 @@ begin
if CompareIdentifiers('VAR',r)=0 then if CompareIdentifiers('VAR',r)=0 then
EndIdentifierSectionAndProc; EndIdentifierSectionAndProc;
end; end;
if Stack.Top<>Result then
DebugLn(['TFullyAutomaticBeautifier.FindStackPosForBlockCloseAtPos block close: Stack.Top=',Stack.Top,' Result=',Result]);
end; end;
procedure TFullyAutomaticBeautifier.WriteDebugReport(Msg: string; procedure TFullyAutomaticBeautifier.WriteDebugReport(Msg: string;
@ -1605,6 +1712,7 @@ begin
bbtVarSection, bbtVarSection,
bbtResourceStringSection, bbtResourceStringSection,
bbtLabelSection, bbtLabelSection,
bbtDefinition,
bbtRecord, bbtRecord,
bbtClassSection, bbtClassSection,
bbtMainBegin, bbtMainBegin,