MG: added guess unclosed block

git-svn-id: trunk@587 -
This commit is contained in:
lazarus 2002-01-11 20:41:53 +00:00
parent 1f09b8a479
commit a91d8446f3
7 changed files with 475 additions and 71 deletions

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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.

View File

@ -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);

View File

@ -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