mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 13:56:05 +02:00
MG: added guess unclosed block
git-svn-id: trunk@587 -
This commit is contained in:
parent
1f09b8a479
commit
a91d8446f3
@ -144,6 +144,10 @@ type
|
||||
function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
|
||||
var NewCode: TCodeBuffer;
|
||||
var NewX, NewY, NewTopLine: integer): boolean;
|
||||
function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer;
|
||||
var NewCode: TCodeBuffer;
|
||||
var NewX, NewY, NewTopLine: integer): boolean;
|
||||
|
||||
|
||||
// find declaration
|
||||
function FindDeclaration(Code: TCodeBuffer; X,Y: integer;
|
||||
@ -593,6 +597,38 @@ writeln('TCodeToolManager.FindBlockCounterPart END ');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
|
||||
var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
NewPos: TCodeXYPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename,' x=',x,' y=',y);
|
||||
{$ENDIF}
|
||||
if not InitCodeTool(Code) then exit;
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.GuessUnclosedBlock B ',FCodeTool.Scanner<>nil);
|
||||
{$ENDIF}
|
||||
try
|
||||
Result:=FCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
|
||||
if Result then begin
|
||||
NewX:=NewPos.X;
|
||||
NewY:=NewPos.Y;
|
||||
NewCode:=NewPos.Code;
|
||||
end;
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.GuessUnclosedBlock END ');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TCodeToolManager.GetCompatibleMethods(Code: TCodeBuffer;
|
||||
const AClassName: string; TypeData: PTypeData; Proc: TGetStringProc);
|
||||
begin
|
||||
|
@ -95,6 +95,7 @@ type
|
||||
procedure MoveCursorToCleanPos(ACleanPos: integer); virtual;
|
||||
function ReadTilSection(SectionType: TCodeTreeNodeDesc): boolean;
|
||||
function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean;
|
||||
function ReadBackTilBracketClose(ExceptionOnNotFound: boolean): boolean;
|
||||
function DoAtom: boolean; virtual;
|
||||
procedure ReadNextAtom; virtual;
|
||||
procedure UndoReadNextAtom; virtual;
|
||||
@ -916,6 +917,7 @@ end;
|
||||
|
||||
function TCustomCodeTool.ReadTilBracketClose(
|
||||
ExceptionOnNotFound: boolean): boolean;
|
||||
// reads code brackets (not comment brackets)
|
||||
var CloseBracket, AntiCloseBracket: char;
|
||||
Start: TAtomPosition;
|
||||
begin
|
||||
@ -951,6 +953,44 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.ReadBackTilBracketClose(
|
||||
ExceptionOnNotFound: boolean): boolean;
|
||||
// reads code brackets (not comment brackets)
|
||||
var CloseBracket, AntiCloseBracket: char;
|
||||
Start: TAtomPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
if AtomIsChar(')') then begin
|
||||
CloseBracket:='(';
|
||||
AntiCloseBracket:='[';
|
||||
end else if AtomIsChar(']') then begin
|
||||
CloseBracket:='[';
|
||||
AntiCloseBracket:='(';
|
||||
end else begin
|
||||
if ExceptionOnNotFound then
|
||||
RaiseException(
|
||||
'syntax error: bracket close expected, but '+GetAtom+' found');
|
||||
exit;
|
||||
end;
|
||||
Start:=CurPos;
|
||||
repeat
|
||||
ReadPriorAtom;
|
||||
if (AtomIsChar(CloseBracket)) then break;
|
||||
if (CurPos.StartPos<1) or AtomIsChar(AntiCloseBracket)
|
||||
or UpAtomIs('END') or UpAtomIs('BEGIN') then begin
|
||||
CurPos:=Start;
|
||||
if ExceptionOnNotFound then
|
||||
RaiseException(
|
||||
'syntax error: bracket '+CloseBracket+' not found');
|
||||
exit;
|
||||
end;
|
||||
if (AtomIsChar(')')) or (AtomIsChar(']')) then begin
|
||||
if not ReadBackTilBracketClose(ExceptionOnNotFound) then exit;
|
||||
end;
|
||||
until false;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TCustomCodeTool.BeginParsing(DeleteNodes,
|
||||
OnlyInterfaceNeeded: boolean);
|
||||
begin
|
||||
|
@ -181,8 +181,10 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint B');
|
||||
if CleanCursorPos>=LastAtomEnd then CleanCursorPos:=LastAtomEnd-1;
|
||||
// find CodeTreeNode at cursor
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos);
|
||||
if CursorNode=nil then
|
||||
if CursorNode=nil then begin
|
||||
WriteDebugTreeReport;
|
||||
RaiseException('no node found at cursor');
|
||||
end;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(CursorNode.Desc));
|
||||
{$ENDIF}
|
||||
@ -213,15 +215,6 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint D ',CleanCursorPos,', |',copy(Src,
|
||||
or (not (CursorNode.Desc in [ctnProcedureHead,ctnProcedure])) then
|
||||
exit;
|
||||
// build the method name + parameter list (without default values)
|
||||
//SearchedProc:=ExtractProcHead(CursorNode,
|
||||
// [phpWithParameterNames,phpAddClassname]);
|
||||
{$IFDEF CTDEBUG}
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint E SearchedProc="',SearchedProc,'"');
|
||||
{$ENDIF}
|
||||
//if SearchedProc='' then exit;
|
||||
// search the method
|
||||
//ProcNode:=FindProcNode(TypeSectionNode,SearchedProc,
|
||||
// [phpWithParameterNames,phpIgnoreForwards]);
|
||||
Result:=FindBestProcNode(CursorNode,[phpAddClassName,phpInUpperCase],
|
||||
TypeSectionNode,[phpIgnoreForwards,phpInUpperCase]);
|
||||
{$IFDEF CTDEBUG}
|
||||
@ -309,17 +302,8 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 2B ');
|
||||
{$ENDIF}
|
||||
|
||||
// build the method name + parameter list (without default values)
|
||||
//SearchedProc:=ExtractProcHead(ProcNode,[phpInUpperCase]);
|
||||
{$IFDEF CTDEBUG}
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 2C SearchedProc="',SearchedProc,'"');
|
||||
{$ENDIF}
|
||||
//if SearchedProc='' then exit;
|
||||
// search the method
|
||||
//ProcNode:=FindProcNode(ProcNode,SearchedProc,
|
||||
// [phpInUpperCase,phpIgnoreForwards]);
|
||||
Result:=FindBestProcNode(ProcNode,[phpInUpperCase],
|
||||
ProcNode,[phpInUpperCase,phpIgnoreForwards]);
|
||||
//if ProcNode=nil then exit;
|
||||
// find good position in procedure body
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 2D');
|
||||
@ -365,18 +349,6 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4D ',StartNode<>nil);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TMethodJumpingCodeTool.FindJumpPoint 4E ',Result);
|
||||
{$ENDIF}
|
||||
//if ProcNode=nil then begin
|
||||
// there is no exact corresponding proc
|
||||
// -> search for a proc with the same name but different param list
|
||||
// SearchedProc:=ExtractProcHead(ProcNode,
|
||||
// [phpWithoutClassName,phpInUpperCase,phpWithoutBrackets,
|
||||
// phpWithoutParamList]);
|
||||
// ProcNode:=FindProcNode(StartNode,SearchedProc,[phpInUpperCase,
|
||||
// phpWithoutBrackets,phpWithoutParamList]);
|
||||
{$IFDEF CTDEBUG}
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 4E2 ',ProcNode<>nil,' ',SearchedProc);
|
||||
{$ENDIF}
|
||||
//end;
|
||||
if not Result then begin
|
||||
// search first undefined proc node with body
|
||||
SearchForNodes:=GatherProcNodes(StartNode,
|
||||
@ -427,18 +399,8 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint 4G ',DiffNode<>nil);
|
||||
end;
|
||||
end else begin
|
||||
// search forward procedure
|
||||
//SearchedProc:=ExtractProcHead(ProcNode,[phpWithParameterNames]);
|
||||
//ProcNode:=FindProcNode(StartNode,SearchedProc,
|
||||
// [phpWithParameterNames,phpIgnoreProcsWithBody]);
|
||||
//if ProcNode=nil then exit;
|
||||
Result:=FindBestProcNode(ProcNode,[phpInUpperCase],
|
||||
StartNode,[phpInUpperCase,phpIgnoreProcsWithBody]);
|
||||
// find good position in forward procedure
|
||||
{$IFDEF CTDEBUG}
|
||||
//writeln('TMethodJumpingCodeTool.FindJumpPoint 4B');
|
||||
{$ENDIF}
|
||||
//ProcNode:=ProcNode.FirstChild;
|
||||
//Result:=JumpToNode(ProcNode,NewPos,NewTopLine);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
@ -31,7 +31,9 @@
|
||||
|
||||
|
||||
ToDo:
|
||||
|
||||
- ReadBackTilBlockEnd: case could also be in a record, then it should not
|
||||
close the block
|
||||
|
||||
}
|
||||
unit PascalParserTool;
|
||||
|
||||
@ -198,13 +200,16 @@ type
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
type
|
||||
TEndBlockType = (ebtBegin, ebtAsm, ebtTry, ebtCase, ebtRepeat, ebtRecord);
|
||||
TEndBlockType = (ebtBegin, ebtAsm, ebtTry, ebtCase, ebtRepeat, ebtRecord,
|
||||
ebtClass, ebtObject);
|
||||
TTryType = (ttNone, ttFinally, ttExcept);
|
||||
|
||||
|
||||
|
||||
{ TMultiKeyWordListCodeTool }
|
||||
|
||||
@ -1519,7 +1524,8 @@ begin
|
||||
begin
|
||||
if BlockType=ebtAsm then
|
||||
RaiseException('syntax error: unexpected keyword "'+GetAtom+'" found');
|
||||
ReadTilBlockEnd(false);
|
||||
if (BlockType<>ebtRecord) or (not UpAtomIs('CASE')) then
|
||||
ReadTilBlockEnd(false);
|
||||
end else if UpAtomIs('UNTIL') then begin
|
||||
if BlockType=ebtRepeat then
|
||||
break;
|
||||
@ -1586,6 +1592,7 @@ begin
|
||||
end else if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
|
||||
or UpAtomIs('RECORD') then
|
||||
begin
|
||||
// Todo: case could also be in a record, then it should not close the block
|
||||
if BlockType=ebtBegin then
|
||||
break
|
||||
else
|
||||
|
@ -51,6 +51,13 @@ uses
|
||||
|
||||
type
|
||||
TStandardCodeTool = class(TFindDeclarationTool)
|
||||
private
|
||||
BlockKeywordFuncList: TKeyWordFunctionList;
|
||||
procedure BuildBlockKeyWordFuncList;
|
||||
function ReadTilGuessedUnclosedBlock(MinCleanPos: integer;
|
||||
ReadOnlyOneBlock: boolean): boolean;
|
||||
function ReadForwardTilAnyBracketClose: boolean;
|
||||
function ReadBackwardTilAnyBracketClose: boolean;
|
||||
public
|
||||
// source name e.g. 'unit UnitName;'
|
||||
function GetSourceNamePos(var NamePos: TAtomPosition): boolean;
|
||||
@ -119,12 +126,27 @@ type
|
||||
// blocks (e.g. begin..end)
|
||||
function FindBlockCounterPart(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
//function GuessBrokenBlock(StartPos: integer): boolean;
|
||||
function GuessUnclosedBlock(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TBlockKeyword = (bkwNone, bkwBegin, bkwAsm, bkwTry, bkwCase, bkwRepeat,
|
||||
bkwRecord, bkwClass, bkwObject, bkwInterface,
|
||||
bkwDispInterface, bkwEnd, bkwUntil, bkwFinally,
|
||||
bkwExcept);
|
||||
|
||||
const
|
||||
BlockKeywords: array[TBlockKeyword] of string = (
|
||||
'(unknown)', 'BEGIN', 'ASM', 'TRY', 'CASE', 'REPEAT', 'RECORD', 'CLASS',
|
||||
'OBJECT', 'INTERFACE', 'DISPINTERFACE', 'END', 'UNTIL', 'FINALLY',
|
||||
'EXCEPT'
|
||||
);
|
||||
|
||||
|
||||
|
||||
{ TStandardCodeTool }
|
||||
|
||||
@ -956,40 +978,334 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TStandardCodeTool.FindBlockCounterPart A CursorPos=',CursorPos.X,',',CursorPos.Y);
|
||||
{$ENDIF}
|
||||
BeginParsing(true,false);
|
||||
if UpdateNeeded(false) then BeginParsing(true,false);
|
||||
// find the CursorPos in cleaned source
|
||||
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
|
||||
if (Dummy<>0) and (Dummy<>-1) then
|
||||
RaiseException('cursor pos outside of code');
|
||||
// read word at cursor
|
||||
MoveCursorToCleanPos(CleanCursorPos);
|
||||
if Src[CurPos.StartPos] in [';','.'] then dec(CurPos.StartPos);
|
||||
CurPos.EndPos:=CurPos.StartPos;
|
||||
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
||||
dec(CurPos.StartPos);
|
||||
while (CurPos.EndPos<SrcLen) and (IsWordChar[Src[CurPos.EndPos]]) do
|
||||
inc(CurPos.EndPos);
|
||||
if CurPos.EndPos=CurPos.StartPos then exit;
|
||||
if Src[CurPos.StartPos] in ['(','[','{'] then begin
|
||||
// jump forward to matching bracket
|
||||
CurPos.EndPos:=CurPos.StartPos+1;
|
||||
if not ReadForwardTilAnyBracketClose then exit;
|
||||
end else if Src[CurPos.StartPos] in [')',']','}'] then begin
|
||||
// jump backward to matching bracket
|
||||
CurPos.EndPos:=CurPos.StartPos+1;
|
||||
if not ReadBackwardTilAnyBracketClose then exit;
|
||||
end else begin;
|
||||
if Src[CurPos.StartPos] in [';','.'] then dec(CurPos.StartPos);
|
||||
CurPos.EndPos:=CurPos.StartPos;
|
||||
while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
|
||||
dec(CurPos.StartPos);
|
||||
while (CurPos.EndPos<SrcLen) and (IsWordChar[Src[CurPos.EndPos]]) do
|
||||
inc(CurPos.EndPos);
|
||||
if CurPos.EndPos=CurPos.StartPos then exit;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TStandardCodeTool.FindBlockCounterPart C Word=',GetAtom);
|
||||
{$ENDIF}
|
||||
// read till block keyword counterpart
|
||||
if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
|
||||
or UpAtomIs('RECORD') or UpAtomIs('CLASS') or UpAtomIs('OBJECT')
|
||||
or UpAtomIs('TRY') then begin
|
||||
// read forward till END, FINALLY, EXCEPT
|
||||
ReadTilBlockEnd(true);
|
||||
end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then
|
||||
begin
|
||||
// read backward till BEGIN, CASE, ASM, RECORD, CLASS, OBJECT
|
||||
ReadBackTilBlockEnd(true);
|
||||
end else
|
||||
exit;
|
||||
// read till block keyword counterpart
|
||||
if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
|
||||
or UpAtomIs('RECORD') or UpAtomIs('TRY') or UpAtomIs('REPEAT') then begin
|
||||
// read forward till END, FINALLY, EXCEPT
|
||||
ReadTilBlockEnd(true);
|
||||
end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
|
||||
or UpAtomIs('UNTIL') then
|
||||
begin
|
||||
// read backward till BEGIN, CASE, ASM, RECORD, REPEAT
|
||||
ReadBackTilBlockEnd(true);
|
||||
end else
|
||||
exit;
|
||||
end;
|
||||
// CursorPos now contains the counter block keyword
|
||||
Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.GuessUnclosedBlock(CursorPos: TCodeXYPosition;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
{ search a block (e.g. begin..end) that looks unclosed, i.e. 'begin'
|
||||
without 'end' or 'begin' with 'end' in a different column.
|
||||
This function can be used as GuessNextUnclosedBlock, because it ignores blocks
|
||||
in front of CursorPos.
|
||||
|
||||
Examples for good blocks:
|
||||
|
||||
repeat
|
||||
until
|
||||
|
||||
begin end // start and end of block in the same line
|
||||
|
||||
if expr then begin // first char in line is relevant, not the block keyword
|
||||
end
|
||||
|
||||
|
||||
Examples for bad blocks:
|
||||
|
||||
begin // block start and end has different indenting
|
||||
end
|
||||
|
||||
asm // 'end.' is source end, never asm end
|
||||
end.
|
||||
|
||||
try // different indenting
|
||||
finally
|
||||
|
||||
repeat // keywords do not match
|
||||
end
|
||||
|
||||
}
|
||||
var Dummy, CleanCursorPos: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
// scan code
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TStandardCodeTool.GuessUnclosedBlock A CursorPos=',CursorPos.X,',',CursorPos.Y);
|
||||
{$ENDIF}
|
||||
if UpdateNeeded(false) then BeginParsing(true,false);
|
||||
// find the CursorPos in cleaned source
|
||||
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
|
||||
if (Dummy<>0) and (Dummy<>-1) then
|
||||
RaiseException('cursor pos outside of code');
|
||||
// start reading at beginning of code
|
||||
MoveCursorToCleanPos(1);
|
||||
BuildBlockKeyWordFuncList;
|
||||
if ReadTilGuessedUnclosedBlock(CleanCursorPos,false) then
|
||||
Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.ReadTilGuessedUnclosedBlock(
|
||||
MinCleanPos: integer; ReadOnlyOneBlock: boolean): boolean;
|
||||
// returns true if unclosed block found
|
||||
var BlockType, CurBlockWord: TBlockKeyword;
|
||||
BlockStart: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
BlockType:=bkwNone;
|
||||
BlockStart:=-1;
|
||||
// read til this block is closed
|
||||
while (CurPos.StartPos<=SrcLen) do begin
|
||||
if BlockKeywordFuncList.DoItUppercase(UpperSrc,
|
||||
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
|
||||
begin
|
||||
for CurBlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do
|
||||
if UpAtomIs(BlockKeywords[CurBlockWord]) then
|
||||
break;
|
||||
if (CurBlockWord=bkwInterface) and (not LastAtomIs(0,'=')) then
|
||||
CurBlockWord:=bkwNone;
|
||||
|
||||
if (CurBlockWord=bkwEnd) then begin
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('.') then begin
|
||||
// source end found
|
||||
if BlockType in [bkwBegin,bkwNone] then begin
|
||||
CurPos.StartPos:=SrcLen+1;
|
||||
exit;
|
||||
end else begin
|
||||
MoveCursorToCleanPos(BlockStart);
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
UndoReadNextAtom;
|
||||
end;
|
||||
|
||||
if BlockType=bkwNone then begin
|
||||
case CurBlockWord of
|
||||
|
||||
bkwBegin,bkwRepeat,bkwCase,bkwTry,bkwRecord,bkwClass,bkwObject,
|
||||
bkwInterface,bkwDispInterface:
|
||||
begin
|
||||
BlockType:=CurBlockWord;
|
||||
BlockStart:=CurPos.StartPos;
|
||||
end;
|
||||
|
||||
bkwEnd,bkwUntil:
|
||||
begin
|
||||
// close block keywords found, but no block was opened
|
||||
// -> unclosed block found
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
end;
|
||||
end
|
||||
else
|
||||
if ((BlockType in [bkwBegin, bkwAsm, bkwCase, bkwRecord, bkwClass,
|
||||
bkwObject, bkwFinally, bkwExcept, bkwInterface, bkwDispInterface])
|
||||
and (CurBlockWord=bkwEnd))
|
||||
or ((BlockType=bkwRepeat) and (CurBlockWord=bkwUntil)) then begin
|
||||
// block end found
|
||||
if (MinCleanPos<=CurPos.StartPos)
|
||||
and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
|
||||
then begin
|
||||
// different indent -> unclosed block found
|
||||
if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos)
|
||||
then begin
|
||||
// the current block is more or equal indented than the next block
|
||||
// -> probably the current block misses a block end
|
||||
MoveCursorToCleanPos(BlockStart);
|
||||
end;
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
// end block
|
||||
BlockType:=bkwNone;
|
||||
if ReadOnlyOneBlock then break;
|
||||
end
|
||||
else
|
||||
if (BlockType=bkwTry) and (CurBlockWord in [bkwFinally,bkwExcept]) then
|
||||
begin
|
||||
// try..finally, try..except found
|
||||
if (MinCleanPos<=CurPos.StartPos)
|
||||
and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
|
||||
then begin
|
||||
// different indent -> unclosed block found
|
||||
// probably a block start is missing, so the error position is
|
||||
// here at block end
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
// change blocktype
|
||||
BlockType:=CurBlockWord;
|
||||
BlockStart:=CurPos.StartPos;
|
||||
end
|
||||
else
|
||||
if ((BlockType in [bkwBegin,bkwRepeat,bkwTry,bkwFinally,bkwExcept,
|
||||
bkwCase])
|
||||
and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase]))
|
||||
or ((BlockType in [bkwClass,bkwInterface,bkwDispInterface,bkwObject,
|
||||
bkwRecord])
|
||||
and (CurBlockWord in [bkwRecord])) then
|
||||
begin
|
||||
// sub blockstart found -> read recursively
|
||||
Result:=ReadTilGuessedUnclosedBlock(MinCleanPos,true);
|
||||
if Result then exit;
|
||||
end
|
||||
else
|
||||
if (BlockType=bkwRecord) and (CurBlockWord=bkwCase) then begin
|
||||
// variant record
|
||||
end
|
||||
else
|
||||
begin
|
||||
// unexpected keyword found
|
||||
if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos)
|
||||
then begin
|
||||
// the current block is more or equal indented than the next block
|
||||
// -> probably the current block misses a block end
|
||||
MoveCursorToCleanPos(BlockStart);
|
||||
end;
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TStandardCodeTool.BuildBlockKeyWordFuncList;
|
||||
var BlockWord: TBlockKeyword;
|
||||
begin
|
||||
if BlockKeywordFuncList=nil then begin
|
||||
BlockKeywordFuncList:=TKeyWordFunctionList.Create;
|
||||
for BlockWord:=Low(TBlockKeyword) to High(TBlockKeyword) do
|
||||
with BlockKeywordFuncList do
|
||||
Add(BlockKeywords[BlockWord],{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
AddKeyWordFuncList(BlockKeywordFuncList);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.ReadForwardTilAnyBracketClose: boolean;
|
||||
// this function reads any bracket
|
||||
// (the ReadTilBracketClose function reads only brackets in code, not comments)
|
||||
var OpenBracket: char;
|
||||
CommentLvl: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
OpenBracket:=Src[CurPos.StartPos];
|
||||
if OpenBracket='{' then begin
|
||||
// read til end of comment
|
||||
CommentLvl:=1;
|
||||
inc(CurPos.StartPos);
|
||||
while (CurPos.StartPos<=SrcLen) and (CommentLvl>0) do begin
|
||||
case Src[CurPos.StartPos] of
|
||||
'{': if Scanner.NestedComments then inc(CommentLvl);
|
||||
'}':
|
||||
if CommentLvl=1 then begin
|
||||
Result:=true;
|
||||
break;
|
||||
end else
|
||||
dec(CommentLvl);
|
||||
end;
|
||||
inc(CurPos.StartPos);
|
||||
end;
|
||||
end else if OpenBracket='(' then begin
|
||||
if (CurPos.StartPos<SrcLen) and (Src[CurPos.StartPos+1]='*') then begin
|
||||
// read til end of comment
|
||||
inc(CurPos.StartPos,3);
|
||||
while true do begin
|
||||
if (CurPos.StartPos<=SrcLen)
|
||||
and ((Src[CurPos.StartPos-1]='*') and (Src[CurPos.StartPos]=')')) then
|
||||
begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
inc(CurPos.StartPos);
|
||||
end;
|
||||
end else begin
|
||||
Result:=ReadTilBracketClose(false);
|
||||
end;
|
||||
end else if OpenBracket='[' then begin
|
||||
Result:=ReadTilBracketClose(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.ReadBackwardTilAnyBracketClose: boolean;
|
||||
// this function reads any bracket
|
||||
// (the ReadBackTilBracketClose function reads only brackets in code,
|
||||
// not comments)
|
||||
var OpenBracket: char;
|
||||
CommentLvl: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
OpenBracket:=Src[CurPos.StartPos];
|
||||
if OpenBracket='}' then begin
|
||||
// read backwards til end of comment
|
||||
CommentLvl:=1;
|
||||
dec(CurPos.StartPos);
|
||||
while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
|
||||
case Src[CurPos.StartPos] of
|
||||
'}': if Scanner.NestedComments then inc(CommentLvl);
|
||||
'{':
|
||||
if CommentLvl=1 then begin
|
||||
Result:=true;
|
||||
break;
|
||||
end else
|
||||
dec(CommentLvl);
|
||||
end;
|
||||
dec(CurPos.StartPos);
|
||||
end;
|
||||
end else if OpenBracket=')' then begin
|
||||
if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin
|
||||
// read til end of comment
|
||||
dec(CurPos.StartPos,3);
|
||||
while true do begin
|
||||
if (CurPos.StartPos>=1)
|
||||
and ((Src[CurPos.StartPos+11]='*') and (Src[CurPos.StartPos]='(')) then
|
||||
begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
dec(CurPos.StartPos);
|
||||
end;
|
||||
end else begin
|
||||
Result:=ReadBackTilBracketClose(false);
|
||||
end;
|
||||
end else if OpenBracket=']' then begin
|
||||
Result:=ReadBackTilBracketClose(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
@ -843,7 +843,6 @@ var
|
||||
begin
|
||||
if (not SelAvail)
|
||||
or (PrimarySelection.OnRequest=@PrimarySelectionRequest) then exit;
|
||||
writeln('>>> TCustomSynEdit.AquirePrimarySelection <<<');
|
||||
FormatList:=CF_TEXT;
|
||||
try
|
||||
PrimarySelection.SetSupportedFormats(1,@FormatList);
|
||||
|
52
ide/main.pp
52
ide/main.pp
@ -147,6 +147,7 @@ type
|
||||
|
||||
itmToolConfigure: TMenuItem;
|
||||
itmToolSyntaxCheck: TMenuItem;
|
||||
itmToolGuessUnclosedBlockCheck: TMenuItem;
|
||||
|
||||
itmEnvGeneralOptions: TMenuItem;
|
||||
itmEnvEditorOptions: TMenuItem;
|
||||
@ -216,6 +217,7 @@ type
|
||||
// tools menu
|
||||
procedure mnuToolConfigureClicked(Sender : TObject);
|
||||
procedure mnuToolSyntaxCheckClicked(Sender : TObject);
|
||||
procedure mnuToolGuessUnclosedBlockClicked(Sender : TObject);
|
||||
|
||||
// enironment menu
|
||||
procedure mnuEnvGeneralOptionsClicked(Sender : TObject);
|
||||
@ -385,6 +387,7 @@ type
|
||||
procedure DoJumpToCodeToolBossError;
|
||||
function DoCheckSyntax: TModalResult;
|
||||
procedure DoGoToPascalBlockEnd;
|
||||
procedure DoJumpToGuessedUnclosedBlock(FindNext: boolean);
|
||||
|
||||
// methods for debugging, compiling and external tools
|
||||
function DoJumpToCompilerMessage(Index:integer;
|
||||
@ -1403,6 +1406,12 @@ begin
|
||||
itmToolSyntaxCheck.OnClick := @mnuToolSyntaxCheckClicked;
|
||||
mnuTools.Add(itmToolSyntaxCheck);
|
||||
|
||||
itmToolGuessUnclosedBlockCheck := TMenuItem.Create(Self);
|
||||
itmToolGuessUnclosedBlockCheck.Name:='itmToolGuessUnclosedBlockCheck';
|
||||
itmToolGuessUnclosedBlockCheck.Caption := 'Guess unclosed block';
|
||||
itmToolGuessUnclosedBlockCheck.OnClick := @mnuToolGuessUnclosedBlockClicked;
|
||||
mnuTools.Add(itmToolGuessUnclosedBlockCheck);
|
||||
|
||||
|
||||
//--------------
|
||||
// Environment
|
||||
@ -1775,6 +1784,9 @@ begin
|
||||
|
||||
ecSyntaxCheck:
|
||||
DoCheckSyntax;
|
||||
|
||||
ecGuessUnclosedBlock:
|
||||
DoJumpToGuessedUnclosedBlock(true);
|
||||
|
||||
else
|
||||
Handled:=false;
|
||||
@ -2105,6 +2117,11 @@ begin
|
||||
DoCheckSyntax;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuToolGuessUnclosedBlockClicked(Sender : TObject);
|
||||
begin
|
||||
DoJumpToGuessedUnclosedBlock(true);
|
||||
end;
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
|
||||
procedure TMainIDE.SaveDesktopSettings(
|
||||
@ -5176,6 +5193,33 @@ writeln('[TMainIDE.DoGoToPascalBlockEnd] ************');
|
||||
DoJumpToCodeToolBossError;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.DoJumpToGuessedUnclosedBlock(FindNext: boolean);
|
||||
var ActiveSrcEdit: TSourceEditor;
|
||||
ActiveUnitInfo: TUnitInfo;
|
||||
NewSource: TCodeBuffer;
|
||||
StartX, StartY, NewX, NewY, NewTopLine: integer;
|
||||
begin
|
||||
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo) then exit;
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('');
|
||||
writeln('[TMainIDE.DoGoToPascalBlockEnd] ************');
|
||||
{$ENDIF}
|
||||
if FindNext then begin
|
||||
StartX:=ActiveSrcEdit.EditorComponent.CaretX;
|
||||
StartY:=ActiveSrcEdit.EditorComponent.CaretY;
|
||||
end else begin
|
||||
StartX:=1;
|
||||
StartY:=1;
|
||||
end;
|
||||
if CodeToolBoss.GuessUnclosedBlock(ActiveUnitInfo.Source,
|
||||
StartX,StartY,NewSource,NewX,NewY,NewTopLine) then
|
||||
begin
|
||||
DoJumpToCodePos(ActiveSrcEdit, ActiveUnitInfo,
|
||||
NewSource, NewX, NewY, NewTopLine);
|
||||
end else
|
||||
DoJumpToCodeToolBossError;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.DoCompleteCodeAtCursor;
|
||||
var ActiveSrcEdit: TSourceEditor;
|
||||
ActiveUnitInfo: TUnitInfo;
|
||||
@ -5534,8 +5578,8 @@ end.
|
||||
=======
|
||||
|
||||
$Log$
|
||||
Revision 1.198 2002/01/11 15:57:49 lazarus
|
||||
MG: added find block end
|
||||
Revision 1.199 2002/01/11 20:41:52 lazarus
|
||||
MG: added guess unclosed block
|
||||
|
||||
Revision 1.197 2002/01/02 13:32:52 lazarus
|
||||
MG: fixed clean abort of project loading
|
||||
@ -5565,8 +5609,8 @@ end.
|
||||
|
||||
<<<<<<< main.pp
|
||||
$Log$
|
||||
Revision 1.198 2002/01/11 15:57:49 lazarus
|
||||
MG: added find block end
|
||||
Revision 1.199 2002/01/11 20:41:52 lazarus
|
||||
MG: added guess unclosed block
|
||||
|
||||
Revision 1.197 2002/01/02 13:32:52 lazarus
|
||||
MG: fixed clean abort of project loading
|
||||
|
Loading…
Reference in New Issue
Block a user