MG: added guess unclosed block

git-svn-id: trunk@587 -

components/codetools/codetoolmanager.pas

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

components/codetools/customcodetool.pas

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

components/codetools/methodjumptool.pas

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

components/codetools/pascalparsertool.pas

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

components/codetools/stdcodetools.pas

@@ -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);
+  if Src[CurPos.StartPos] in ['(','[','{'] then begin
-  CurPos.EndPos:=CurPos.StartPos;
+    // jump forward to matching bracket
-  while (CurPos.StartPos>2) and IsWordChar[Src[CurPos.StartPos-1]] do
+    CurPos.EndPos:=CurPos.StartPos+1;
-    dec(CurPos.StartPos);
+    if not ReadForwardTilAnyBracketClose then exit;
-  while (CurPos.EndPos<SrcLen) and (IsWordChar[Src[CurPos.EndPos]]) do
+  end else if Src[CurPos.StartPos] in [')',']','}'] then begin
-    inc(CurPos.EndPos);
+    // jump backward to matching bracket
-  if CurPos.EndPos=CurPos.StartPos then exit;
+    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
+    // read till block keyword counterpart
-  if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
+    if UpAtomIs('BEGIN') or UpAtomIs('CASE') or UpAtomIs('ASM')
-  or UpAtomIs('RECORD') or UpAtomIs('CLASS') or UpAtomIs('OBJECT')
+    or UpAtomIs('RECORD') or UpAtomIs('TRY') or UpAtomIs('REPEAT') then begin
-  or UpAtomIs('TRY') then begin
+      // read forward till END, FINALLY, EXCEPT
-    // read forward till END, FINALLY, EXCEPT
+      ReadTilBlockEnd(true);
-    ReadTilBlockEnd(true);
+    end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT')
-  end else if UpAtomIs('END') or UpAtomIs('FINALLY') or UpAtomIs('EXCEPT') then
+    or UpAtomIs('UNTIL') then
-  begin
+    begin
-    // read backward till BEGIN, CASE, ASM, RECORD, CLASS, OBJECT
+      // read backward till BEGIN, CASE, ASM, RECORD, REPEAT
-    ReadBackTilBlockEnd(true);
+      ReadBackTilBlockEnd(true);
-  end else
+    end else
-    exit;
+      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.
 
+

components/synedit/synedit.pp

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

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
+  Revision 1.199  2002/01/11 20:41:52  lazarus
-  MG: added  find block end
+  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
+  Revision 1.199  2002/01/11 20:41:52  lazarus
-  MG: added  find block end
+  MG: added  guess unclosed block
 
   Revision 1.197  2002/01/02 13:32:52  lazarus
   MG: fixed clean abort of project loading