MG: parser can now read system unit, find declaration of used units, bugfxies

git-svn-id: trunk@612 -

components/codetools/codecompletiontool.pas

@@ -773,6 +773,9 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
     // gather existing class proc definitions
     ClassProcs:=GatherProcNodes(StartNode,[phpInUpperCase,phpAddClassName],
        ExtractClassName(ClassNode,true));
+       
+    // ToDo: check for double defined methods in ClassProcs
+       
     // add new class parts to ClassProcs
     CurNode:=FirstExistingProcBody;
     ANodeExt:=FirstInsert;
@@ -805,7 +808,13 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
         if ImplementationNode=nil then 
           RaiseException('implementation node not found');
         Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
-        InsertPos:=ImplementationNode.EndPos;
+        if (ImplementationNode.LastChild=nil)
+        or (ImplementationNode.LastChild.Desc<>ctnBeginBlock) then
+          InsertPos:=ImplementationNode.EndPos
+        else begin
+          InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
+             ImplementationNode.LastChild.StartPos,Scanner.NestedComments);
+        end;
       end else begin
         // class is not in interface section
         // -> insert at the end of the type section
@@ -959,7 +968,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode A CleanCursorPos=',CleanCursorPos,
 writeln('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsString(ClassNode.Desc));
 {$ENDIF}
     // cursor is in class/object definition
-    if CursorNode.SubDesc=ctnsForwardDeclaration then exit;
+    if (CursorNode.SubDesc and ctnsForwardDeclaration)>0 then exit;
     // parse class and build CodeTreeNodes for all properties/methods
 {$IFDEF CTDEBUG}
 writeln('TCodeCompletionCodeTool.CompleteCode C ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8));
@@ -1079,7 +1088,7 @@ writeln('TCodeCompletionCodeTool.CompleteCode not in-a-class ... ');
     ProcNode:=CursorNode;
     if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
     if (ProcNode.Desc=ctnProcedure)
-    and (ProcNode.SubDesc=ctnsForwardDeclaration) then begin
+    and ((ProcNode.SubDesc and ctnsForwardDeclaration)>0) then begin
       // Node is forward Proc
 {$IFDEF CTDEBUG}
 writeln('TCodeCompletionCodeTool.CompleteCode in a forward procedure ... ');
@@ -1097,16 +1106,15 @@ writeln('TCodeCompletionCodeTool.CompleteCode Body not found -> create it ... ')
       // -> create proc body at end of implementation
 
       Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
-      if ImplementationNode.Desc=ctnImplementation then
+      if (ImplementationNode.LastChild=nil)
+      or (ImplementationNode.LastChild.Desc<>ctnBeginBlock) then
+        // insert at end of code
         InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
            ImplementationNode.EndPos,Scanner.NestedComments)
       else begin
         // insert in front of main program begin..end.
-        StartNode:=ImplementationNode.LastChild;
-        if (StartNode=nil) or (StartNode.Desc<>ctnBeginBlock) then 
-          RaiseException('main Begin..End block not found');
-        InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,StartNode.StartPos,
-           Scanner.NestedComments);
+        InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
+           ImplementationNode.LastChild.StartPos,Scanner.NestedComments);
       end;
 
       // build nice proc

components/codetools/codetoolmanager.pas

@@ -40,7 +40,8 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, SysUtils, CodeCompletionTool, CodeTree, CodeAtom, SourceChanger,
-  DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo;
+  DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo,
+  AVL_Tree, CustomCodeTool, FindDeclarationTool;
 
 type
   TCodeToolManager = class;
@@ -54,7 +55,7 @@ type
   private
     FCatchExceptions: boolean;
     FCheckFilesOnDisk: boolean;
-    FCodeTool: TCodeCompletionCodeTool;
+    FCurCodeTool: TCodeCompletionCodeTool; // current codetool
     FCursorBeyondEOL: boolean;
     FErrorCode: TCodeBuffer;
     FErrorColumn: integer;
@@ -66,6 +67,7 @@ type
     FOnAfterApplyChanges: TOnAfterApplyChanges;
     FOnBeforeApplyChanges: TOnBeforeApplyChanges;
     FSourceExtensions: string; // default is '.pp;.pas;.lpr;.dpr;.dpk'
+    FSourceTools: TAVLTree; // tree of TCustomCodeTool
     FVisibleEditorLines: integer;
     FWriteExceptions: boolean;
     function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator;
@@ -73,7 +75,10 @@ type
                                     var Value: string);
     procedure OnGlobalValuesChanged;
     function GetMainCode(Code: TCodeBuffer): TCodeBuffer;
-    function InitCodeTool(Code: TCodeBuffer): boolean;
+    function InitCurCodeTool(Code: TCodeBuffer): boolean;
+    function FindCodeToolForSource(Code: TCodeBuffer): TCustomCodeTool;
+    function GetCodeToolForSource(Code: TCodeBuffer;
+      ExceptionOnError: boolean): TCustomCodeTool;
     procedure SetCheckFilesOnDisk(NewValue: boolean);
     procedure SetIndentSize(NewValue: integer);
     procedure SetVisibleEditorLines(NewValue: integer);
@@ -82,6 +87,8 @@ type
     procedure BeforeApplyingChanges(var Abort: boolean);
     procedure AfterApplyingChanges;
     function HandleException(AnException: Exception): boolean;
+    function OnGetCodeToolForBuffer(Sender: TObject;
+      Code: TCodeBuffer): TFindDeclarationTool;
   public
     DefinePool: TDefinePool; // definition templates (rules)
     DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
@@ -144,6 +151,9 @@ type
     function FindBlockCounterPart(Code: TCodeBuffer; X,Y: integer;
           var NewCode: TCodeBuffer;
           var NewX, NewY, NewTopLine: integer): boolean;
+    function FindBlockStart(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;
@@ -241,6 +251,21 @@ var CodeToolBoss: TCodeToolManager;
 implementation
 
 
+function CompareCodeToolMainSources(Data1, Data2: Pointer): integer;
+var
+  Src1, Src2: integer;
+begin
+  Src1:=Integer(TCustomCodeTool(Data1).Scanner.MainCode);
+  Src2:=Integer(TCustomCodeTool(Data2).Scanner.MainCode);
+  if Src1<Src2 then
+    Result:=-1
+  else if Src1>Src2 then
+    Result:=+1
+  else
+    Result:=0;
+end;
+
+
 { TCodeToolManager }
 
 constructor TCodeToolManager.Create;
@@ -262,6 +287,7 @@ begin
   FVisibleEditorLines:=20;
   FJumpCentered:=true;
   FCursorBeyondEOL:=true;
+  FSourceTools:=TAVLTree.Create(@CompareCodeToolMainSources);
 end;
 
 destructor TCodeToolManager.Destroy;
@@ -273,7 +299,8 @@ writeln('[TCodeToolManager.Destroy] A');
 {$IFDEF CTDEBUG}
 writeln('[TCodeToolManager.Destroy] B');
 {$ENDIF}
-  FCodeTool.Free;
+  FSourceTools.FreeAndClear;
+  FSourceTools.Free;
 {$IFDEF CTDEBUG}
 writeln('[TCodeToolManager.Destroy] C');
 {$ENDIF}
@@ -410,7 +437,7 @@ begin
   Result:=SourceChangeCache.Apply;
 end;
 
-function TCodeToolManager.InitCodeTool(Code: TCodeBuffer): boolean;
+function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
 var MainCode: TCodeBuffer;
 begin
   Result:=false;
@@ -419,23 +446,15 @@ begin
   fErrorLine:=-1;
   MainCode:=GetMainCode(Code);
   if MainCode=nil then begin
-    fErrorMsg:='TCodeToolManager.InitCodeTool MainCode=nil';
+    fErrorMsg:='TCodeToolManager.InitCurCodeTool MainCode=nil';
     exit;
   end;
-  if FCodeTool=nil then begin
-    FCodeTool:=TCodeCompletionCodeTool.Create;
-    FCodeTool.CheckFilesOnDisk:=FCheckFilesOnDisk;
-    FCodeTool.IndentSize:=FIndentSize;
-    FCodeTool.VisibleEditorLines:=FVisibleEditorLines;
-    FCodeTool.JumpCentered:=FJumpCentered;
-    FCodeTool.CursorBeyondEOL:=FCursorBeyondEOL;
-  end;
-  FCodeTool.ErrorPosition.Code:=nil;
-  FCodeTool.Scanner:=MainCode.Scanner;
+  FCurCodeTool:=TCodeCompletionCodeTool(GetCodeToolForSource(MainCode,true));
+  FCurCodeTool.ErrorPosition.Code:=nil;
 {$IFDEF CTDEBUG}
-writeln('[TCodeToolManager.InitCodeTool] ',Code.Filename,' ',Code.SourceLength);
+writeln('[TCodeToolManager.InitCurCodeTool] ',Code.Filename,' ',Code.SourceLength);
 {$ENDIF}
-  Result:=(FCodeTool.Scanner<>nil);
+  Result:=(FCurCodeTool.Scanner<>nil);
   if not Result then begin
     fErrorCode:=MainCode;
     fErrorMsg:='No scanner available';
@@ -443,26 +462,36 @@ writeln('[TCodeToolManager.InitCodeTool] ',Code.Filename,' ',Code.SourceLength);
 end;
 
 function TCodeToolManager.HandleException(AnException: Exception): boolean;
+var ErrorSrcTool: TCustomCodeTool;
 begin
   fErrorMsg:=AnException.Message;
-  if FCodeTool<>nil then begin
-    fErrorCode:=FCodeTool.ErrorPosition.Code;
-    fErrorColumn:=FCodeTool.ErrorPosition.X;
-    fErrorLine:=FCodeTool.ErrorPosition.Y;
+  if (AnException is ELinkScannerError)
+  and (FCurCodeTool<>nil) and (FCurCodeTool.Scanner<>nil)
+  and (FCurCodeTool.Scanner.Code<>nil)
+  and (FCurCodeTool.Scanner.LinkCount>0) then begin
+    fErrorCode:=TCodeBuffer(FCurCodeTool.Scanner.Code);
+    if fErrorCode<>nil then
+      fErrorCode.AbsoluteToLineCol(
+        FCurCodeTool.Scanner.SrcPos,fErrorLine,fErrorColumn);
+  end else if (AnException is ECodeToolError) then begin
+    ErrorSrcTool:=ECodeToolError(AnException).Sender;
+    fErrorCode:=ErrorSrcTool.ErrorPosition.Code;
+    fErrorColumn:=ErrorSrcTool.ErrorPosition.X;
+    fErrorLine:=ErrorSrcTool.ErrorPosition.Y;
+    fErrorTopLine:=fErrorLine;
+    if JumpCentered then begin
+      dec(fErrorTopLine,VisibleEditorLines div 2);
+      if fErrorTopLine<1 then fErrorTopLine:=1;
+    end;
+  end else if FCurCodeTool<>nil then begin
+    fErrorCode:=FCurCodeTool.ErrorPosition.Code;
+    fErrorColumn:=FCurCodeTool.ErrorPosition.X;
+    fErrorLine:=FCurCodeTool.ErrorPosition.Y;
     fErrorTopLine:=fErrorLine;
     if JumpCentered then begin
       dec(fErrorTopLine,VisibleEditorLines div 2);
       if fErrorTopLine<1 then fErrorTopLine:=1;
     end;
-  end;
-  if (AnException is ELinkScannerError)
-  and (FCodeTool<>nil) and (FCodeTool.Scanner<>nil)
-  and (FCodeTool.Scanner.Code<>nil)
-  and (FCodeTool.Scanner.LinkCount>0) then begin
-    fErrorCode:=TCodeBuffer(FCodeTool.Scanner.Code);
-    if fErrorCode<>nil then
-      fErrorCode.AbsoluteToLineCol(
-        FCodeTool.Scanner.SrcPos,fErrorLine,fErrorColumn);
   end;
   if FWriteExceptions then begin
 {$IFDEF CTDEBUG}
@@ -485,8 +514,8 @@ function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
 begin
   Result:=false;
   try
-    if InitCodeTool(Code) then begin
-      FCodeTool.BuildTree(false);
+    if InitCurCodeTool(Code) then begin
+      FCurCodeTool.BuildTree(false);
       Result:=true;
     end;
   except
@@ -509,15 +538,15 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.JumpToMethod A ',Code.Filename,' x=',x,' y=',y);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
 {$IFDEF CTDEBUG}
-writeln('TCodeToolManager.JumpToMethod B ',FCodeTool.Scanner<>nil);
+writeln('TCodeToolManager.JumpToMethod B ',FCurCodeTool.Scanner<>nil);
 {$ENDIF}
   try
-    Result:=FCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine);
+    Result:=FCurCodeTool.FindJumpPoint(CursorPos,NewPos,NewTopLine);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;
@@ -542,15 +571,15 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindDeclaration A ',Code.Filename,' x=',x,' y=',y);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
 {$IFDEF CTDEBUG}
-writeln('TCodeToolManager.FindDeclaration B ',FCodeTool.Scanner<>nil);
+writeln('TCodeToolManager.FindDeclaration B ',FCurCodeTool.Scanner<>nil);
 {$ENDIF}
   try
-    Result:=FCodeTool.FindDeclaration(CursorPos,NewPos,NewTopLine);
+    Result:=FCurCodeTool.FindDeclaration(CursorPos,NewPos,NewTopLine);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;
@@ -575,15 +604,15 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindBlockCounterPart A ',Code.Filename,' x=',x,' y=',y);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
 {$IFDEF CTDEBUG}
-writeln('TCodeToolManager.FindBlockCounterPart B ',FCodeTool.Scanner<>nil);
+writeln('TCodeToolManager.FindBlockCounterPart B ',FCurCodeTool.Scanner<>nil);
 {$ENDIF}
   try
-    Result:=FCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine);
+    Result:=FCurCodeTool.FindBlockCounterPart(CursorPos,NewPos,NewTopLine);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;
@@ -597,6 +626,39 @@ writeln('TCodeToolManager.FindBlockCounterPart END ');
 {$ENDIF}
 end;
 
+function TCodeToolManager.FindBlockStart(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.FindBlockStart A ',Code.Filename,' x=',x,' y=',y);
+{$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  CursorPos.X:=X;
+  CursorPos.Y:=Y;
+  CursorPos.Code:=Code;
+{$IFDEF CTDEBUG}
+writeln('TCodeToolManager.FindBlockStart B ',FCurCodeTool.Scanner<>nil);
+{$ENDIF}
+  try
+    Result:=FCurCodeTool.FindBlockStart(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.FindBlockStart END ');
+{$ENDIF}
+end;
+
 function TCodeToolManager.GuessUnclosedBlock(Code: TCodeBuffer; X, Y: integer;
   var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
 var
@@ -607,15 +669,15 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.GuessUnclosedBlock A ',Code.Filename,' x=',x,' y=',y);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
 {$IFDEF CTDEBUG}
-writeln('TCodeToolManager.GuessUnclosedBlock B ',FCodeTool.Scanner<>nil);
+writeln('TCodeToolManager.GuessUnclosedBlock B ',FCurCodeTool.Scanner<>nil);
 {$ENDIF}
   try
-    Result:=FCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
+    Result:=FCurCodeTool.GuessUnclosedBlock(CursorPos,NewPos,NewTopLine);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;
@@ -635,9 +697,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.GetCompatibleMethods A ',Code.Filename,' Classname=',AClassname);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    FCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName),
+    FCurCodeTool.GetCompatiblePublishedMethods(UpperCaseStr(AClassName),
        TypeData,Proc);
   except
     on e: Exception do HandleException(e);
@@ -650,10 +712,10 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.MethodExists A ',Code.Filename,' ',AClassName,':',AMethodName);
 {$ENDIF}
-  Result:=InitCodeTool(Code);
+  Result:=InitCurCodeTool(Code);
   if not Result then exit;
   try
-    Result:=FCodeTool.PublishedMethodExists(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.PublishedMethodExists(UpperCaseStr(AClassName),
               UpperCaseStr(AMethodName),TypeData);
   except
     on e: Exception do Result:=HandleException(e);
@@ -668,10 +730,10 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.JumpToMethodBody A ',Code.Filename,' ',AClassName,':',AMethodName);
 {$ENDIF}
-  Result:=InitCodeTool(Code);
+  Result:=InitCurCodeTool(Code);
   if not Result then exit;
   try
-    Result:=FCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.JumpToPublishedMethodBody(UpperCaseStr(AClassName),
               UpperCaseStr(AMethodName),TypeData,NewPos,NewTopLine);
     if Result then begin
       NewCode:=NewPos.Code;
@@ -689,11 +751,11 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RenameMethod A');
 {$ENDIF}
-  Result:=InitCodeTool(Code);
+  Result:=InitCurCodeTool(Code);
   if not Result then exit;
   try
     SourceChangeCache.Clear;
-    Result:=FCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.RenamePublishedMethod(UpperCaseStr(AClassName),
               UpperCaseStr(OldMethodName),NewMethodName,TypeData,
               SourceChangeCache);
   except
@@ -707,11 +769,11 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.CreateMethod A');
 {$ENDIF}
-  Result:=InitCodeTool(Code);
+  Result:=InitCurCodeTool(Code);
   if not Result then exit;
   try
     SourceChangeCache.Clear;
-    Result:=FCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.CreatePublishedMethod(UpperCaseStr(AClassName),
               NewMethodName,TypeData,SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -728,12 +790,12 @@ begin
 writeln('TCodeToolManager.CompleteCode A ',Code.Filename,' x=',x,' y=',y);
 {$ENDIF}
   Result:=false;
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   CursorPos.X:=X;
   CursorPos.Y:=Y;
   CursorPos.Code:=Code;
   try
-    Result:=FCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache);
+    Result:=FCurCodeTool.CompleteCode(CursorPos,NewPos,NewTopLine,SourceChangeCache);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;
@@ -753,9 +815,9 @@ writeln('TCodeToolManager.GetSourceName A ',Code.Filename,' ',Code.SourceLength)
 {$IFDEF MEM_CHECK}
 CheckHeap(IntToStr(GetMem_Cnt));
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.GetSourceName;
+    Result:=FCurCodeTool.GetSourceName;
   except
     on e: Exception do HandleException(e);
   end;
@@ -774,11 +836,11 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.GetSourceType A ',Code.Filename,' ',Code.SourceLength);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
     // GetSourceType does not parse the code -> parse it with GetSourceName
-    FCodeTool.GetSourceName;
-    case FCodeTool.GetSourceType of
+    FCurCodeTool.GetSourceName;
+    case FCurCodeTool.GetSourceType of
       ctnProgram: Result:='PROGRAM';
       ctnPackage: Result:='PACKAGE';
       ctnLibrary: Result:='LIBRARY';
@@ -805,9 +867,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RenameSource A ',Code.Filename,' NewName=',NewName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.RenameSource(NewName,SourceChangeCache);
+    Result:=FCurCodeTool.RenameSource(NewName,SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
   end;
@@ -822,12 +884,12 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindUnitInAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindUnitInAllUsesSections B ',Code.Filename,' UnitName=',AnUnitName);
 {$ENDIF}
   try
-    Result:=FCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName),
+    Result:=FCurCodeTool.FindUnitInAllUsesSections(UpperCaseStr(AnUnitName),
                 NameAtomPos, InAtomPos);
     if Result then begin
       NamePos:=NameAtomPos.StartPos;
@@ -845,9 +907,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RenameUsedUnit A, ',Code.Filename,' Old=',OldUnitName,' New=',NewUnitName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName,
+    Result:=FCurCodeTool.RenameUsedUnit(UpperCaseStr(OldUnitName),NewUnitName,
                   NewUnitInFile,SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -861,9 +923,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.AddUnitToMainUsesSection A ',Code.Filename,' NewUnitName=',NewUnitName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
+    Result:=FCurCodeTool.AddUnitToMainUsesSection(NewUnitName, NewUnitInFile,
                     SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -877,9 +939,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RemoveUnitFromAllUsesSections A ',Code.Filename,' UnitName=',AnUnitName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName),
+    Result:=FCurCodeTool.RemoveUnitFromAllUsesSections(UpperCaseStr(AnUnitName),
                 SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -895,10 +957,10 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
     LinkIndex:=-1;
-    CurCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
+    CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
     while (CurCode<>nil) do begin
       if UpperCaseStr(ExtractFileExt(CurCode.Filename))='.LRS' then begin
         Result:=CurCode.Filename;
@@ -906,7 +968,7 @@ writeln('TCodeToolManager.FindLFMFileName A ',Code.Filename);
         Result:=copy(Result,1,length(Result)-length(Ext))+'.lfm';
         exit;
       end;
-      CurCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
+      CurCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
     end;
   except
     on e: Exception do HandleException(e);
@@ -920,9 +982,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindNextResourceFile A ',Code.Filename);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
+    Result:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
   except
     on e: Exception do HandleException(e);
   end;
@@ -935,9 +997,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.FindLazarusResource(ResourceName);
+    Result:=FCurCodeTool.FindLazarusResource(ResourceName);
   except
     on e: Exception do HandleException(e);
   end;
@@ -952,15 +1014,15 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',length(ResourceData));
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.AddLazarusResource B ');
 {$ENDIF}
   try
     LinkIndex:=-1;
-    ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
+    ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
     if ResCode=nil then exit;
-    Result:=FCodeTool.AddLazarusResource(Rescode,ResourceName,ResourceData,
+    Result:=FCurCodeTool.AddLazarusResource(Rescode,ResourceName,ResourceData,
                   SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -976,12 +1038,12 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
     LinkIndex:=-1;
-    ResCode:=FCodeTool.FindNextIncludeInInitialization(LinkIndex);
+    ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
     if ResCode=nil then exit;
-    Result:=FCodeTool.RemoveLazarusResource(ResCode,ResourceName,
+    Result:=FCurCodeTool.RemoveLazarusResource(ResCode,ResourceName,
                        SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -996,11 +1058,11 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RenameMainInclude A ',Code.Filename,' NewFilename=',NewFilename,' KeepPath=',KeepPath);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
     LinkIndex:=-1;
-    if FCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
-    Result:=FCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
+    if FCurCodeTool.FindNextIncludeInInitialization(LinkIndex)=nil then exit;
+    Result:=FCurCodeTool.RenameInclude(LinkIndex,NewFilename,KeepPath,
                        SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -1018,9 +1080,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.FindCreateFormStatement A ',Code.Filename,' StartPos=',StartPos,' ',AClassName,':',AVarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.FindCreateFormStatement(StartPos,UpperCaseStr(AClassName),
                  UpperCaseStr(AVarName),PosAtom);
     if Result<>-1 then
       Position:=PosAtom.StartPos;
@@ -1036,9 +1098,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.AddCreateFormStatement A ',Code.Filename,' ',AClassName,':',AVarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.AddCreateFormStatement(AClassName,AVarName,
+    Result:=FCurCodeTool.AddCreateFormStatement(AClassName,AVarName,
                     SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -1052,9 +1114,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RemoveCreateFormStatement A ',Code.Filename,' ',AVarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName),
+    Result:=FCurCodeTool.RemoveCreateFormStatement(UpperCaseStr(AVarName),
                     SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -1068,9 +1130,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.ListAllCreateFormStatements A ',Code.Filename);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.ListAllCreateFormStatements;
+    Result:=FCurCodeTool.ListAllCreateFormStatements;
   except
     on e: Exception do HandleException(e);
   end;
@@ -1083,9 +1145,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.SetAllCreateFromStatements A ',Code.Filename);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
+    Result:=FCurCodeTool.SetAllCreateFromStatements(List,SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
   end;
@@ -1098,9 +1160,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.PublishedVariableExists A ',Code.Filename,' ',AClassName,':',AVarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.FindPublishedVariable(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.FindPublishedVariable(UpperCaseStr(AClassName),
                  UpperCaseStr(AVarName))<>nil;
   except
     on e: Exception do Result:=HandleException(e);
@@ -1114,9 +1176,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.AddPublishedVariable A ',Code.Filename,' ',AClassName,':',VarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.AddPublishedVariable(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.AddPublishedVariable(UpperCaseStr(AClassName),
                       VarName,VarType,SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -1130,9 +1192,9 @@ begin
 {$IFDEF CTDEBUG}
 writeln('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassName,':',AVarName);
 {$ENDIF}
-  if not InitCodeTool(Code) then exit;
+  if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName),
+    Result:=FCurCodeTool.RemovePublishedVariable(UpperCaseStr(AClassName),
                UpperCaseStr(AVarName),SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
@@ -1168,40 +1230,40 @@ procedure TCodeToolManager.SetCheckFilesOnDisk(NewValue: boolean);
 begin
   if NewValue=FCheckFilesOnDisk then exit;
   FCheckFilesOnDisk:=NewValue;
-  if FCodeTool<>nil then
-    FCodeTool.CheckFilesOnDisk:=NewValue;
+  if FCurCodeTool<>nil then
+    FCurCodeTool.CheckFilesOnDisk:=NewValue;
 end;
 
 procedure TCodeToolManager.SetIndentSize(NewValue: integer);
 begin
   if NewValue=FIndentSize then exit;
   FIndentSize:=NewValue;
-  if FCodeTool<>nil then
-    FCodeTool.IndentSize:=NewValue;
+  if FCurCodeTool<>nil then
+    FCurCodeTool.IndentSize:=NewValue;
 end;
 
 procedure TCodeToolManager.SetVisibleEditorLines(NewValue: integer);
 begin
   if NewValue=FVisibleEditorLines then exit;
   FVisibleEditorLines:=NewValue;
-  if FCodeTool<>nil then
-    FCodeTool.VisibleEditorLines:=NewValue;
+  if FCurCodeTool<>nil then
+    FCurCodeTool.VisibleEditorLines:=NewValue;
 end;
 
 procedure TCodeToolManager.SetJumpCentered(NewValue: boolean);
 begin
   if NewValue=FJumpCentered then exit;
   FJumpCentered:=NewValue;
-  if FCodeTool<>nil then
-    FCodeTool.JumpCentered:=NewValue;
+  if FCurCodeTool<>nil then
+    FCurCodeTool.JumpCentered:=NewValue;
 end;
 
 procedure TCodeToolManager.SetCursorBeyondEOL(NewValue: boolean);
 begin
   if NewValue=FCursorBeyondEOL then exit;
   FCursorBeyondEOL:=NewValue;
-  if FCodeTool<>nil then
-    FCodeTool.CursorBeyondEOL:=NewValue;
+  if FCurCodeTool<>nil then
+    FCurCodeTool.CursorBeyondEOL:=NewValue;
 end;
 
 procedure TCodeToolManager.BeforeApplyingChanges(var Abort: boolean);
@@ -1216,13 +1278,78 @@ begin
     FOnAfterApplyChanges(Self);
 end;
 
+function TCodeToolManager.FindCodeToolForSource(Code: TCodeBuffer
+  ): TCustomCodeTool;
+var ANode: TAVLTreeNode;
+  CurSrc, SearchedSrc: integer;
+begin
+  ANode:=FSourceTools.Root;
+  SearchedSrc:=integer(Code);
+  while (ANode<>nil) do begin
+    CurSrc:=integer(TCustomCodeTool(ANode.Data).Scanner.MainCode);
+    if CurSrc>SearchedSrc then
+      ANode:=ANode.Left
+    else if CurSrc<SearchedSrc then
+      ANode:=ANode.Right
+    else begin
+      Result:=TCustomCodeTool(ANode.Data);
+      exit;
+    end;
+  end;
+  Result:=nil;
+end;
+
+function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
+  ExceptionOnError: boolean): TCustomCodeTool;
+// return a codetool for the source
+var MainCode: TCodeBuffer;
+begin
+  Result:=nil;
+  if Code=nil then begin
+    if ExceptionOnError then
+      raise Exception.Create('TCodeToolManager.GetCodeToolForSource '
+        +'internal error: Code=nil');
+    exit;
+  end;
+  Result:=FindCodeToolForSource(Code);
+  if Result=nil then begin
+    MainCode:=GetMainCode(Code);   // create a scanner
+    if (MainCode<>Code) then begin
+      if ExceptionOnError then
+        raise Exception.Create('the source file "'+Code.Filename+'"'
+          +' is an include file of "'+Code.Filename+'"');
+      exit;
+    end;
+    Result:=TCodeCompletionCodeTool.Create;
+    Result.Scanner:=Code.Scanner;
+    FSourceTools.Add(Result);
+  end;
+  Result.CheckFilesOnDisk:=FCheckFilesOnDisk;
+  Result.IndentSize:=FIndentSize;
+  Result.VisibleEditorLines:=FVisibleEditorLines;
+  Result.JumpCentered:=FJumpCentered;
+  Result.CursorBeyondEOL:=FCursorBeyondEOL;
+  TFindDeclarationTool(Result).OnGetCodeToolForBuffer:=@OnGetCodeToolForBuffer;
+end;
+
+function TCodeToolManager.OnGetCodeToolForBuffer(Sender: TObject;
+  Code: TCodeBuffer): TFindDeclarationTool;
+begin
+{$IFDEF CTDEBUG}
+writeln('[TCodeToolManager.OnGetCodeToolForBuffer]'
+  ,' Sender=',TCustomCodeTool(Sender).Scanner.MainSource.Filename
+  ,' Code=',Code.Filename);
+{$ENDIF}
+  Result:=TFindDeclarationTool(GetCodeToolForSource(Code,true));
+end;
+
 function TCodeToolManager.ConsistencyCheck: integer;
 // 0 = ok
 begin
   try
     Result:=0;
-    if FCodeTool<>nil then begin
-      Result:=FCodeTool.ConsistencyCheck;
+    if FCurCodeTool<>nil then begin
+      Result:=FCurCodeTool.ConsistencyCheck;
       if Result<>0 then begin
         dec(Result,1000);  exit;
       end;
@@ -1247,6 +1374,10 @@ begin
     if Result<>0 then begin
       dec(Result,6000);  exit;
     end;
+    Result:=FSourceTools.ConsistencyCheck;
+    if Result<>0 then begin
+      dec(Result,7000);  exit;
+    end;
   finally
     if (Result<>0) and (FCatchExceptions=false) then
       raise Exception.Create(
@@ -1259,11 +1390,11 @@ procedure TCodeToolManager.WriteDebugReport(WriteTool,
   WriteDefPool, WriteDefTree, WriteCache, WriteGlobalValues: boolean);
 begin
   writeln('[TCodeToolManager.WriteDebugReport] Consistency=',ConsistencyCheck);
-  if FCodeTool<>nil then begin
+  if FCurCodeTool<>nil then begin
     if WriteTool then
-      FCodeTool.WriteDebugTreeReport
+      FCurCodeTool.WriteDebugTreeReport
     else
-      writeln('  FCodeTool.ConsistencyCheck=',FCodeTool.ConsistencyCheck);
+      writeln('  FCurCodeTool.ConsistencyCheck=',FCurCodeTool.ConsistencyCheck);
   end;
   if WriteDefPool then
     DefinePool.WriteDebugReport

components/codetools/codetree.pas

@@ -121,12 +121,16 @@ const
       ctnIdentifier,ctnArrayType,ctnRecordType,ctnRecordCase,ctnRecordVariant,
       ctnProcedureType,ctnSetType,ctnRangeType,ctnEnumType,ctnLabelType,
       ctnTypeType,ctnFileType,ctnPointerType,ctnClassOfType];
+  AllSourceTypes =
+     [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];
+  AllUsableSoureTypes =
+     [ctnUnit];
 
 
   // CodeTreeNodeSubDescriptors
-  ctnsNone                 = 0;
-  ctnsForwardDeclaration   = 1;
-  ctnsProcHeadNodesCreated = 2;
+  ctnsNone               = 0;
+  ctnsForwardDeclaration = 1;
+  ctnsNeedJITParsing     = 2;
   
 type
   TCodeTreeNode = class

components/codetools/customcodetool.pas

@@ -94,6 +94,8 @@ type
     procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); virtual;
     procedure MoveCursorToNodeStart(ANode: TCodeTreeNode);
     procedure MoveCursorToCleanPos(ACleanPos: integer);
+    procedure MoveCursorToCleanPos(ACleanPos: PChar);
+    function IsPCharInSrc(ACleanPos: PChar): boolean;
     function ReadTilSection(SectionType: TCodeTreeNodeDesc): boolean;
     function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean;
     function ReadBackTilBracketClose(ExceptionOnNotFound: boolean): boolean;
@@ -125,6 +127,11 @@ type
       CleanStartPos1, CleanStartPos2: integer): boolean;
     function CompareSrcIdentifier(CleanStartPos: integer;
       const Identifier: string): boolean;
+    function CompareSrcIdentifiers(Identifier1, Identifier2: PChar): boolean;
+    function CompareSrcIdentifiers(CleanStartPos: integer;
+      AnIdentifier: PChar): boolean;
+    function GetIdentifier(Identifier: PChar): string;
+    function GetIdentifier(CleanStartPos: integer): string;
     procedure ReadPriorAtom;
 
     procedure CreateChildNode;
@@ -139,7 +146,10 @@ type
     destructor Destroy; override;
   end;
 
-  ECodeToolError = class(Exception);
+  ECodeToolError = class(Exception)
+    Sender: TCustomCodeTool;
+    constructor Create(ASender: TCustomCodeTool; const AMessage: string);
+  end;
 
 
 implementation
@@ -180,16 +190,19 @@ end;
 
 procedure TCustomCodeTool.RaiseException(const AMessage: string);
 var CaretXY: TCodeXYPosition;
+  CursorPos: integer;
 begin
   ErrorPosition.Code:=nil;
-  if (CleanPosToCaret(CurPos.StartPos,CaretXY))
+  CursorPos:=CurPos.StartPos;
+  if (CursorPos>SrcLen) and (SrcLen>0) then CursorPos:=SrcLen;
+  if (CleanPosToCaret(CursorPos,CaretXY))
   and (CaretXY.Code<>nil) then begin
     ErrorPosition:=CaretXY;
   end else if (Scanner<>nil) and (Scanner.MainCode<>nil) then begin
     ErrorPosition.Code:=TCodeBuffer(Scanner.MainCode);
     ErrorPosition.Y:=-1;
   end;
-  raise ECodeToolError.Create(AMessage);
+  raise ECodeToolError.Create(Self,AMessage);
 end;
 
 procedure TCustomCodeTool.SetScanner(NewScanner: TLinkScanner);
@@ -215,18 +228,18 @@ begin
     Result:='';
   case Desc of
   ctnProcedure:
-    case SubDesc of
-    // CodeTreeNodeSubDescriptors
-    ctnsForwardDeclaration : Result:='Forward';
+    begin
+      if (SubDesc and ctnsForwardDeclaration)>0 then Result:='Forward';
+    end;
+  ctnProcedureHead, ctnBeginBlock:
+    begin
+      if (SubDesc and ctnsNeedJITParsing)>0 then Result:='Unparsed';
     end;
   ctnClass:
-    case SubDesc of
-    // CodeTreeNodeSubDescriptors
-    ctnsForwardDeclaration : Result:='Forward';
-    end;
-  ctnProcedureHead:
-    case SubDesc of
-    ctnsProcHeadNodesCreated: Result:='Nodes Created';
+    begin
+      Result:='';
+      if (SubDesc and ctnsForwardDeclaration)>0 then Result:='Forward';
+      if (SubDesc and ctnsNeedJITParsing)>0 then Result:=Result+'Unparsed';
     end;
   end;
 end;
@@ -380,14 +393,14 @@ begin
       else begin
         if ExceptionOnNotFound then
           RaiseException(
-            'syntax error: identifier expected, but keyword '+GetAtom+' found')
+            'identifier expected, but keyword '+GetAtom+' found')
         else
           Result:=false;
       end;
     end else begin
       if ExceptionOnNotFound then
         RaiseException(
-          'syntax error: identifier expected, but '+GetAtom+' found')
+          'identifier expected, but '+GetAtom+' found')
       else
         Result:=false;
     end;
@@ -548,10 +561,22 @@ begin
           '''':
             begin
               inc(CurPos.EndPos);
-              while (CurPos.EndPos<=SrcLen)
-              and (Src[CurPos.EndPos]<>'''') do
-                inc(CurPos.EndPos);
-              inc(CurPos.EndPos);
+              while (CurPos.EndPos<=SrcLen) do begin
+                case Src[CurPos.EndPos] of
+                
+                '''':
+                  begin
+                    inc(CurPos.EndPos);
+                    break;
+                  end;
+                  
+                #10,#13:
+                  break;
+                  
+                else
+                  inc(CurPos.EndPos);
+                end;
+              end;
             end;
           else
             break;
@@ -653,7 +678,8 @@ const
     ntIdentifier, ntCharConstant, ntFloat, ntFloatWithExponent];
 
 var c1, c2: char;
-  CommentLvl, PrePos: integer;
+  CommentLvl, PrePos, OldPrePos: integer;
+  IsStringConstant: boolean;
   ForbiddenNumberTypes: TNumberTypes;
 begin
   if LastAtoms.Count>0 then begin
@@ -663,9 +689,12 @@ begin
   // Skip all spaces and comments
   CommentLvl:=0;
   dec(CurPos.StartPos);
+  IsStringConstant:=false;
+  OldPrePos:=0;
   while CurPos.StartPos>=1 do begin
     if IsCommentEndChar[Src[CurPos.StartPos]] then begin
       case Src[CurPos.StartPos] of
+      
       '}': // pascal comment
         begin
           CommentLvl:=1;
@@ -678,29 +707,89 @@ begin
             dec(CurPos.StartPos);
           end;
         end;
+        
       #10,#13: // possible Delphi comment
         begin
-          // read backwards till line start or comment start
           dec(CurPos.StartPos);
           if (CurPos.StartPos>=1) and (Src[CurPos.StartPos] in [#10,#13])
           and (Src[CurPos.StartPos+1]<>Src[CurPos.StartPos]) then
             dec(CurPos.StartPos);
+          // read backwards till line start
           PrePos:=CurPos.StartPos;
-          while (PrePos>1) do begin
+          while (PrePos>=1) and (not (Src[PrePos] in [#10,#13])) do
+            dec(PrePos);
+          // read line forward to find out,
+          // if line ends in comment or string constant
+          repeat
+            inc(PrePos);
             case Src[PrePos] of
+            
             '/':
-              if Src[PrePos-1]='/' then begin
+              if Src[PrePos+1]='/' then begin
                 // this was a delphi comment -> skip comment
-                CurPos.StartPos:=PrePos-2;
+                CurPos.StartPos:=PrePos-1;
                 break;
               end;
+              
+            '{':
+              begin
+                // skip pascal comment
+                CommentLvl:=1;
+                inc(PrePos);
+                while (PrePos<=CurPos.StartPos) and (CommentLvl>0) do begin
+                  case Src[PrePos] of
+                  '{': if Scanner.NestedComments then inc(CommentLvl);
+                  '}': dec(CommentLvl);
+                  end;
+                  inc(PrePos);
+                end;
+              end;
+              
+            '(':
+              begin
+                inc(PrePos);
+                if Src[PrePos]='*' then begin
+                  // skip turbo pascal comment
+                  inc(PrePos);
+                  while (PrePos<CurPos.StartPos)
+                  and ((Src[PrePos]<>'*') or (Src[PrePos+1]<>')')) do
+                    inc(PrePos);
+                  inc(PrePos);
+                end;
+              end;
+              
+            '''':
+              begin
+                // a string constant -> skip it
+                OldPrePos:=PrePos;
+                repeat
+                  inc(PrePos);
+                  case Src[PrePos] of
+                  
+                  '''':
+                    break;
+
+                  #10,#13:
+                    begin
+                      // string constant right border is the line end
+                      // -> last atom of line found
+                      IsStringConstant:=true;
+                      break;
+                    end;
+
+                  end;
+                until false;
+                if IsStringConstant then break;
+              end;
+              
             #10,#13:
-              // it was just a line break
+              // no comment and no string constant found
               break;
+
             end;
-            dec(PrePos);
-          end;
-        end;
+          until PrePos>=CurPos.StartPos;
+        end; // end of possible Delphi comment
+        
       ')': // old turbo pascal comment
         if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin
           dec(CurPos.StartPos,3);
@@ -710,6 +799,7 @@ begin
           dec(CurPos.StartPos);
         end else
           break;
+          
       end;
     end else if IsSpaceChar[Src[CurPos.StartPos]] then begin
       repeat
@@ -725,6 +815,13 @@ begin
   if CurPos.StartPos<1 then
     exit;
   // read atom
+  if IsStringConstant then begin
+    CurPos.StartPos:=OldPrePos;
+    if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='''') then begin
+      ReadStringConstantBackward;
+    end;
+    exit;
+  end;
   c2:=UpperSrc[CurPos.StartPos];
   case c2 of
     '_','A'..'Z':
@@ -901,7 +998,7 @@ begin
   end else begin
     if ExceptionOnNotFound then
       RaiseException(
-        'syntax error: bracket open expected, but '+GetAtom+' found');
+        'bracket open expected, but '+GetAtom+' found');
     exit;
   end;
   Start:=CurPos;
@@ -913,7 +1010,7 @@ begin
       CurPos:=Start;
       if ExceptionOnNotFound then
         RaiseException(
-          'syntax error: bracket '+CloseBracket+' not found');
+          'bracket '+CloseBracket+' not found');
       exit;
     end;
     if (AtomIsChar('(')) or (AtomIsChar('[')) then begin
@@ -939,7 +1036,7 @@ begin
   end else begin
     if ExceptionOnNotFound then
       RaiseException(
-        'syntax error: bracket close expected, but '+GetAtom+' found');
+        'bracket close expected, but '+GetAtom+' found');
     exit;
   end;
   Start:=CurPos;
@@ -951,7 +1048,7 @@ begin
       CurPos:=Start;
       if ExceptionOnNotFound then
         RaiseException(
-          'syntax error: bracket '+CloseBracket+' not found');
+          'bracket '+CloseBracket+' not found');
       exit;
     end;
     if (AtomIsChar(')')) or (AtomIsChar(']')) then begin
@@ -965,10 +1062,13 @@ procedure TCustomCodeTool.BeginParsing(DeleteNodes,
   OnlyInterfaceNeeded: boolean);
 begin
   Scanner.Scan(OnlyInterfaceNeeded,CheckFilesOnDisk);
-  Src:=Scanner.CleanedSrc;
-  FLastScannerChangeStep:=Scanner.ChangeStep;
-  UpperSrc:=UpperCaseStr(Src);
-  SrcLen:=length(Src);
+  if FLastScannerChangeStep<>Scanner.ChangeStep then begin
+    FLastScannerChangeStep:=Scanner.ChangeStep;
+    Src:=Scanner.CleanedSrc;
+    UpperSrc:=UpperCaseStr(Src);
+    SrcLen:=length(Src);
+    FForceUpdateNeeded:=true;
+  end;
   CurPos.StartPos:=1;
   CurPos.EndPos:=1;
   LastAtoms.Clear;
@@ -992,6 +1092,28 @@ begin
   CurNode:=nil;
 end;
 
+procedure TCustomCodeTool.MoveCursorToCleanPos(ACleanPos: PChar);
+var NewPos: integer;
+begin
+  if Src='' then
+    RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] Src empty');
+  NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1;
+  if (NewPos<1) or (NewPos>SrcLen) then
+    RaiseException('[TCustomCodeTool.MoveCursorToCleanPos - PChar] '
+      +'CleanPos not in Src');
+  MoveCursorToCleanPos(NewPos);
+end;
+
+function TCustomCodeTool.IsPCharInSrc(ACleanPos: PChar): boolean;
+var NewPos: integer;
+begin
+  Result:=false;
+  if Src='' then exit;
+  NewPos:=Integer(ACleanPos)-Integer(@Src[1])+1;
+  if (NewPos<1) or (NewPos>SrcLen) then exit;
+  Result:=true;
+end;
+
 procedure TCustomCodeTool.CreateChildNode;
 var NewNode: TCodeTreeNode;
 begin
@@ -1229,5 +1351,74 @@ begin
     and ((CleanStartPos>Srclen) or (not IsIdentChar[Src[CleanStartPos]]));
 end;
 
+function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar
+  ): boolean;
+begin
+  Result:=false;
+  if (Identifier1=nil) or (Identifier2=nil) then exit;
+  while IsIdentChar[Identifier1[0]] do begin
+    if (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) then begin
+      inc(Identifier1);
+      inc(Identifier2);
+    end else
+      exit;
+  end;
+  Result:=(not IsIdentChar[Identifier2[0]]);
+end;
+
+function TCustomCodeTool.CompareSrcIdentifiers(CleanStartPos: integer;
+  AnIdentifier: PChar): boolean;
+begin
+  Result:=false;
+  if (AnIdentifier=nil) or (CleanStartPos<1) or (CleanStartPos>SrcLen) then
+    exit;
+  while IsIdentChar[AnIdentifier[0]] do begin
+    if (UpChars[AnIdentifier[0]]=UpperSrc[CleanStartPos]) then begin
+      inc(AnIdentifier);
+      inc(CleanStartPos);
+      if CleanStartPos>SrcLen then break;
+    end else
+      exit;
+  end;
+  Result:=(CleanStartPos>SrcLen) or (not IsIdentChar[Src[CleanStartPos]]);
+end;
+
+function TCustomCodeTool.GetIdentifier(Identifier: PChar): string;
+var len: integer;
+begin
+  if Identifier<>nil then begin
+    len:=0;
+    while (IsIdentChar[Identifier[len]]) do inc(len);
+    SetLength(Result,len);
+    if len>0 then
+      Move(Identifier[0],Result[1],len);
+  end else
+    Result:='';
+end;
+
+function TCustomCodeTool.GetIdentifier(CleanStartPos: integer): string;
+var len: integer;
+begin
+  if (CleanStartPos>=1) then begin
+    len:=0;
+    while (CleanStartPos<=SrcLen)
+    and (IsIdentChar[Src[CleanStartPos+len]]) do
+      inc(len);
+    SetLength(Result,len);
+    if len>0 then
+      Move(Src[CleanStartPos],Result[1],len);
+  end else
+    Result:='';
+end;
+
+
+{ ECodeToolError }
+
+constructor ECodeToolError.Create(ASender: TCustomCodeTool;
+  const AMessage: string);
+begin
+  inherited Create(AMessage);
+  Sender:=ASender;
+end;
 
 end.

components/codetools/definetemplates.pas

@@ -1323,8 +1323,7 @@ end;
 
 function TDefinePool.CreateFPCSrcTemplate(
   const FPCSrcDir, UnitSearchPath: string): TDefineTemplate;
-var DefTempl, MainDir,
-  FCLDir, RTLDir, PackagesDir, CompilerDir: TDefineTemplate;
+var
   Dir, TargetOS, SrcOS, TargetProcessor, UnitLinks, UnitLinkList,
   IncPathMacro: string;
   DS: char;
@@ -1571,6 +1570,8 @@ var DefTempl, MainDir,
 
 // function TDefinePool.CreateFPCSrcTemplate(
 //   const FPCSrcDir: string): TDefineTemplate;
+var
+  DefTempl, MainDir, FCLDir, RTLDir, PackagesDir, CompilerDir: TDefineTemplate;
 begin
   Result:=nil;
   if (FPCSrcDir='') or (not DirectoryExists(FPCSrcDir)) then exit;
@@ -1620,6 +1621,7 @@ begin
     +';'+Dir+'rtl/objpas/'
     +';'+Dir+'rtl/inc/'
     +';'+Dir+'rtl/'+TargetProcessor+'/'
+    +';'+Dir+'rtl/'+SrcOS+'/'
     ,da_DefineAll));
 
   // fcl
@@ -1663,8 +1665,10 @@ begin
     'lcl;lcl'+ds+'interfaces'+ds+WidgetType+';'+SrcPath
     ,da_Define));
   MainDir.AddChild(TDefineTemplate.Create('Component path addition',
-    'adds designer and synedit to SrcPath',ExternalMacroStart+'SrcPath',
-    'components'+ds+'synedit;components'+ds+'codetools;designer;'+SrcPath
+    'adds designer, debugger, synedit and codetools to SrcPath',
+    ExternalMacroStart+'SrcPath',
+    'components'+ds+'synedit;components'+ds+'codetools;designer;debugger;'
+      +SrcPath
     ,da_Define));
   MainDir.AddChild(TDefineTemplate.Create('includepath addition',
     'adds include to IncPath',ExternalMacroStart+'IncPath',
@@ -1685,9 +1689,9 @@ begin
   DirTempl:=TDefineTemplate.Create('LCL','LCL Directory',
     '','lcl',da_Directory);
   DirTempl.AddChild(TDefineTemplate.Create('WidgetPath',
-     'adds widget path to SrcPath'
+     'adds abstract widget path to SrcPath'
     ,ExternalMacroStart+'SrcPath',
-    'interfaces'+ds+WidgetType+';'+SrcPath
+    'interfaces'+ds+'abstract'+ds+';'+SrcPath
     ,da_Define));
   DirTempl.AddChild(TDefineTemplate.Create('IncludePath',
      'adds include to IncPaty',ExternalMacroStart+'IncPath',
@@ -1703,10 +1707,10 @@ begin
   DirTempl.AddChild(SubDirTempl);
   
   // components
-  DirTempl:=TDefineTemplate.Create('Components','Components Dircetory',
+  DirTempl:=TDefineTemplate.Create('Components','Components Directory',
     '','components',da_Directory);
   DirTempl.AddChild(TDefineTemplate.Create('LCL Path','adds lcl to SrcPath',
-    'SrcPath',
+    ExternalMacroStart+'SrcPath',
     LazarusSrcDir+ds+'lcl'
     +';'+LazarusSrcDir+ds+'lcl'+ds+'interfaces'+ds+WidgetType
     +';'+SrcPath
@@ -1714,7 +1718,15 @@ begin
   MainDir.AddChild(DirTempl);
 
   // tools
-  
+  DirTempl:=TDefineTemplate.Create('Tools','Tools Directory',
+    '','tools',da_Directory);
+  DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
+    'adds lcl to SrcPath',
+    ExternalMacroStart+'SrcPath',
+    '..'+ds+'lcl;..'+ds+'lcl'+ds+'interfaces'+ds+WidgetType+';'+SrcPath
+    ,da_Define));
+  MainDir.AddChild(DirTempl);
+
   // include
   
   // designer

components/codetools/keywordfunclists.pas

@@ -73,12 +73,16 @@ var
   IsKeyWordMethodSpecifier,
   IsKeyWordProcedureSpecifier,
   IsKeyWordProcedureTypeSpecifier,
+  IsKeyWordProcedureBracketSpecifier,
   IsKeyWordSection,
   IsKeyWordInConstAllowed,
   WordIsKeyWord,
   IsKeyWordBuiltInFunc,
   WordIsTermOperator,
-  WordIsPropertySpecifier: TKeyWordFunctionList;
+  WordIsPropertySpecifier,
+  WordIsBlockKeyWord,
+  WordIsLogicalBlockStart,
+  UnexpectedKeyWordInBeginBlock: TKeyWordFunctionList;
   UpChars: array[char] of char;
 
 function UpperCaseStr(const s: string): string;
@@ -377,6 +381,8 @@ end;
 
 //-----------------------------------------------------------------------------
 
+var KeyWordLists: TList;
+
 procedure InternalInit;
 var c: char;
 begin
@@ -388,7 +394,9 @@ begin
     end;
     UpChars[c]:=upcase(c);
   end;
+  KeyWordLists:=TList.Create;
   IsKeyWordMethodSpecifier:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordMethodSpecifier);
   with IsKeyWordMethodSpecifier do begin
     Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -403,6 +411,7 @@ begin
     Add('MESSAGE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   IsKeyWordProcedureSpecifier:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordProcedureSpecifier);
   with IsKeyWordProcedureSpecifier do begin
     Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -414,8 +423,21 @@ begin
     Add('FORWARD' ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('PASCAL'  ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('ASSEMBLER',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('['       ,{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
+  IsKeyWordProcedureBracketSpecifier:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordProcedureBracketSpecifier);
+  with IsKeyWordProcedureBracketSpecifier do begin
+    Add('ALIAS'        ,{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PUBLIC'       ,{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERNPROC'   ,{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERNCONST'  ,{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('IOCHECK'      ,{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   IsKeyWordProcedureTypeSpecifier:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordProcedureTypeSpecifier);
   with IsKeyWordProcedureTypeSpecifier do begin
     Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('REGISTER',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -424,6 +446,7 @@ begin
     Add('PASCAL'  ,{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   IsKeyWordSection:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordSection);
   with IsKeyWordSection do begin
     Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -435,7 +458,9 @@ begin
     Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   IsKeyWordInConstAllowed:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordInConstAllowed);
   with IsKeyWordInConstAllowed do begin
+    Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -449,6 +474,7 @@ begin
     Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   WordIsKeyWord:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(WordIsKeyWord);
   with WordIsKeyWord do begin
     Add('ABSOLUTE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -470,7 +496,6 @@ begin
     Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('EXPORTS',{$ifdef FPC}@{$endif}AllwaysTrue);
-    Add('FILE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('FOR',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -517,12 +542,14 @@ begin
     Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   IsKeyWordBuiltInFunc:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(IsKeyWordBuiltInFunc);
   with IsKeyWordBuiltInFunc do begin
     Add('LOW',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('HIGH',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('ORD',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   WordIsTermOperator:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(WordIsTermOperator);
   with WordIsTermOperator do begin
     Add('+',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('-',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -532,11 +559,14 @@ begin
     Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('SHL',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('SHR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   WordIsPropertySpecifier:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(WordIsPropertySpecifier);
   with WordIsPropertySpecifier do begin
     Add('INDEX',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('READ',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -546,30 +576,95 @@ begin
     Add('DEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('NODEFAULT',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
+  WordIsBlockKeyWord:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(WordIsBlockKeyWord);
+  with WordIsBlockKeyWord do begin
+    Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
+  UnexpectedKeyWordInBeginBlock:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(UnexpectedKeyWordInBeginBlock);
+  with UnexpectedKeyWordInBeginBlock do begin
+    Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CONST',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('LIBRARY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PACKAGE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RESOURCESTRING',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('TYPE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('VAR',{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
+  WordIsLogicalBlockStart:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(WordIsLogicalBlockStart);
+  with WordIsLogicalBlockStart do begin
+    Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('[',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('{',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('(',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('FUNCTION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PRIVATE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PUBLISHED',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PUBLIC',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROTECTED',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('LIBRARY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PACKAGE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
 end;
 
+procedure InternalFinal;
+var i: integer;
+begin
+  for i:=0 to KeyWordLists.Count-1 do
+    TKeyWordFunctionList(KeyWordLists[i]).Free;
+  KeyWordLists.Free;
+  KeyWordLists:=nil;
+end;
+
+
 initialization
   InternalInit;
   
 finalization
-  IsKeyWordMethodSpecifier.Free;
-  IsKeyWordMethodSpecifier:=nil;
-  IsKeyWordProcedureSpecifier.Free;
-  IsKeyWordProcedureSpecifier:=nil;
-  IsKeyWordProcedureTypeSpecifier.Free;
-  IsKeyWordProcedureTypeSpecifier:=nil;
-  IsKeyWordSection.Free;
-  IsKeyWordSection:=nil;
-  IsKeyWordInConstAllowed.Free;
-  IsKeyWordInConstAllowed:=nil;
-  WordIsKeyWord.Free;
-  WordIsKeyWord:=nil;
-  IsKeyWordBuiltInFunc.Free;
-  IsKeyWordBuiltInFunc:=nil;
-  WordIsTermOperator.Free;
-  WordIsTermOperator:=nil;
-  WordIsPropertySpecifier.Free;
-  WordIsPropertySpecifier:=nil;
-
+  InternalFinal;
+  
 end.
 

components/codetools/linkscanner.pas

@@ -141,6 +141,7 @@ type
     FIncludeStack: TList; // list of TSourceLink
     FSkippingTillEndif: boolean;
     FSkipIfLevel: integer;
+    FCompilerMode: TCompilerMode;
     procedure SkipTillEndifElse;
     function SkipIfDirective: boolean;
     function IfdefDirective: boolean;
@@ -210,6 +211,7 @@ type
         read FInitValues write FInitValues;
     property MainCode: pointer read FMainCode write SetMainCode;
     property NestedComments: boolean read FNestedComments;
+    property CompilerMode: TCompilerMode read FCompilerMode write FCompilerMode;
     property ScanTillInterfaceEnd: boolean
         read FScanTillInterfaceEnd write SetScanTillInterfaceEnd;
     procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
@@ -588,6 +590,7 @@ writeln('TLinkScanner.Scan C ',SrcLen);
   EndOfSourceFound:=false;
   CommentStyle:=CommentNone;
   CommentLevel:=0;
+  CompilerMode:=cmFPC;
   IfLevel:=0;
   FSkippingTillEndif:=false;
   if Assigned(FOnGetInitValues) then
@@ -991,12 +994,17 @@ begin
   // undefine all mode macros
   for AMode:=Low(TCompilerMode) to High(TCompilerMode) do
     Values.Undefine('FPC_'+CompilerModeNames[AMode]);
+  CompilerMode:=cmFPC;
   // define new mode macro
   if (ValueStr='DEFAULT') then begin
+  
+    // ToDo: set mode to cmdline mode
+  
   end else begin
     ModeValid:=false;
     for AMode:=Low(TCompilerMode) to High(TCompilerMode) do
       if CompilerModeNames[AMode]=ValueStr then begin
+        CompilerMode:=AMode;
         Values.Variables['FPC_'+CompilerModeNames[AMode]]:='1';
         ModeValid:=true;
         break;
@@ -1320,7 +1328,7 @@ begin
   Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
   ResultStr:=Values.Eval(Expr);
   if Values.ErrorPosition>=0 then
-    raise ELinkScannerError.Create('syntax error in directive expression ')
+    raise ELinkScannerError.Create('in directive expression ')
   else if ResultStr='0' then
     SkipTillEndifElse
   else

components/codetools/methodjumptool.pas

@@ -195,7 +195,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint C ',NodeDescriptionAsString(Cursor
 {$IFDEF CTDEBUG}
 writeln('TMethodJumpingCodeTool.FindJumpPoint C2 ',NodeDescriptionAsString(ClassNode.Desc));
 {$ENDIF}
-    if ClassNode.SubDesc=ctnsForwardDeclaration then exit;
+    if (ClassNode.SubDesc and ctnsForwardDeclaration)>0 then exit;
     // parse class and build CodeTreeNodes for all properties/methods
 {$IFDEF CTDEBUG}
 writeln('TMethodJumpingCodeTool.FindJumpPoint D ',CleanCursorPos,', |',copy(Src,CleanCursorPos,8));
@@ -291,7 +291,7 @@ writeln('TMethodJumpingCodeTool.FindJumpPoint N ',DiffTxtPos);
 writeln('TMethodJumpingCodeTool.FindJumpPoint 2A ',ProcNode<>nil);
 {$ENDIF}
   if ProcNode<>nil then begin
-    if ProcNode.SubDesc=ctnsForwardDeclaration then begin
+    if (ProcNode.SubDesc and ctnsForwardDeclaration)>0 then begin
       // forward declaration -> search procedure
 {$IFDEF CTDEBUG}
 writeln('TMethodJumpingCodeTool.FindJumpPoint 2B ');
@@ -494,7 +494,7 @@ begin
 //writeln('[TMethodJumpingCodeTool.GatherProcNodes] A ',NodeDescriptionAsString(ANode.Desc));
     if ANode.Desc=ctnProcedure then begin
       if (not ((phpIgnoreForwards in Attr)
-           and (ANode.SubDesc=ctnsForwardDeclaration)))
+           and ((ANode.SubDesc and ctnsForwardDeclaration)>0)))
       and (not ((phpIgnoreProcsWithBody in Attr)
             and (FindProcBody(ANode)<>nil))) then
       begin

components/codetools/stdcodetools.pas

@@ -52,8 +52,6 @@ uses
 type
   TStandardCodeTool = class(TFindDeclarationTool)
   private
-    BlockKeywordFuncList: TKeyWordFunctionList;
-    procedure BuildBlockKeyWordFuncList;
     function ReadTilGuessedUnclosedBlock(MinCleanPos: integer;
       ReadOnlyOneBlock: boolean): boolean;
     function ReadForwardTilAnyBracketClose: boolean;
@@ -126,6 +124,8 @@ type
     // blocks (e.g. begin..end)
     function FindBlockCounterPart(CursorPos: TCodeXYPosition;
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
+    function FindBlockStart(CursorPos: TCodeXYPosition;
+      var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
     function GuessUnclosedBlock(CursorPos: TCodeXYPosition;
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
   end;
@@ -133,6 +133,7 @@ type
 
 implementation
 
+
 type
   TBlockKeyword = (bkwNone, bkwBegin, bkwAsm, bkwTry, bkwCase, bkwRepeat,
                    bkwRecord, bkwClass, bkwObject, bkwInterface,
@@ -146,6 +147,19 @@ const
       'EXCEPT'
     );
 
+var
+  BlockKeywordFuncList: TKeyWordFunctionList;
+
+procedure 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);
+  end;
+end;
 
 
 { TStandardCodeTool }
@@ -229,11 +243,11 @@ begin
   SectionNode:=Tree.Root;
   while (SectionNode<>nil) and (SectionNode.Desc in [ctnProgram, ctnUnit,
     ctnPackage,ctnLibrary,ctnInterface,ctnImplementation]) do begin
-    if SectionNode.Desc in [ctnProgram, ctnPackage,ctnLibrary, ctnInterface,
-       ctnImplementation] then
+    if SectionNode.Desc in [ctnProgram, ctnInterface, ctnImplementation] then
     begin
       UsesNode:=SectionNode.FirstChild;
-      if FindUnitInUsesSection(UsesNode,UpperUnitName,NamePos,InPos) then begin
+      if (UsesNode.Desc=ctnUsesSection)
+      and FindUnitInUsesSection(UsesNode,UpperUnitName,NamePos,InPos) then begin
         Result:=true;
         exit;
       end;
@@ -436,8 +450,8 @@ begin
   Result:=true;
   SectionNode:=Tree.Root;
   while (SectionNode<>nil) do begin
-    if (SectionNode.Desc in [ctnProgram,ctnPackage,ctnLibrary,ctnInterface,
-         ctnImplementation]) then begin
+    if (SectionNode.Desc in [ctnProgram,ctnInterface,ctnImplementation]) then
+    begin
       if RemoveUnitFromUsesSection(SectionNode.FirstChild,UpperUnitName,
          SourceChangeCache) then begin
         Result:=RemoveUnitFromAllUsesSections(UpperUnitName,SourceChangeCache);
@@ -971,6 +985,8 @@ end;
 
 function TStandardCodeTool.FindBlockCounterPart(CursorPos: TCodeXYPosition;
       var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
+// jump from bracket-open to bracket-close or 'begin' to 'end'
+// or 'until' to 'repeat' ...
 var Dummy, CleanCursorPos: integer;
 begin
   Result:=false;
@@ -1021,6 +1037,63 @@ writeln('TStandardCodeTool.FindBlockCounterPart C  Word=',GetAtom);
   Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
 end;
 
+function TStandardCodeTool.FindBlockStart(CursorPos: TCodeXYPosition;
+  var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
+// jump to beginning of current block
+// e.g. bracket open, 'begin', 'repeat', ...
+var Dummy, CleanCursorPos: integer;
+begin
+  Result:=false;
+  // scan code
+{$IFDEF CTDEBUG}
+writeln('TStandardCodeTool.FindBlockStart 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');
+  // read word at cursor
+  MoveCursorToCleanPos(CleanCursorPos);
+  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);
+  try
+    repeat
+      ReadPriorAtom;
+      if (CurPos.StartPos<0) then begin
+        // start of source found -> this is always a block start
+        CurPos.StartPos:=1;
+        Result:=true;
+        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 if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc,
+        CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
+      begin
+        // block start found
+        Result:=true;
+        exit;
+      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;
+    until false;
+  finally
+    if Result then begin
+      // CursorPos now contains the counter block keyword
+      Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
+    end;
+  end;
+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'
@@ -1037,6 +1110,8 @@ function TStandardCodeTool.GuessUnclosedBlock(CursorPos: TCodeXYPosition;
     
     if expr then begin  // first char in line is relevant, not the block keyword
     end
+    
+    class;
 
         
   Examples for bad blocks:
@@ -1071,6 +1146,7 @@ writeln('TStandardCodeTool.GuessUnclosedBlock A CursorPos=',CursorPos.X,',',Curs
   BuildBlockKeyWordFuncList;
   if ReadTilGuessedUnclosedBlock(CleanCursorPos,false) then
     Result:=CleanPosToCaretAndTopLine(CurPos.StartPos,NewPos,NewTopLine);
+ WriteDebugTreeReport;
 end;
 
 function TStandardCodeTool.ReadTilGuessedUnclosedBlock(
@@ -1112,14 +1188,30 @@ begin
       if BlockType=bkwNone then begin
         case CurBlockWord of
 
-        bkwBegin,bkwRepeat,bkwCase,bkwTry,bkwRecord,bkwClass,bkwObject,
-        bkwInterface,bkwDispInterface:
+        bkwBegin, bkwAsm, bkwRepeat, bkwCase, bkwTry, bkwRecord:
           begin
             BlockType:=CurBlockWord;
             BlockStart:=CurPos.StartPos;
           end;
+          
+        bkwClass, bkwObject, bkwInterface, bkwDispInterface:
+          begin
+            ReadNextAtom;
+            if AtomIsChar(';')
+            or ((CurBlockWord=bkwClass) and UpAtomIs('OF'))
+            or ((CurBlockWord=bkwClass)
+                and (UpAtomIs('FUNCTION') or UpAtomIs('PROCEDURE')))
+            or ((CurBlockWord=bkwObject) and LastUpAtomIs(0,'OF')) then
+            begin
+              // forward class or 'class of' or class method or 'of object'
+            end else begin
+              UndoReadNextAtom;
+              BlockType:=CurBlockWord;
+              BlockStart:=CurPos.StartPos;
+            end;
+          end;
 
-        bkwEnd,bkwUntil:
+        bkwEnd, bkwUntil:
           begin
             // close block keywords found, but no block was opened
             //  -> unclosed block found
@@ -1149,6 +1241,10 @@ begin
           exit;
         end;
         // end block
+        if (BlockType=bkwRecord) and (CurBlockWord=bkwCase) then begin
+          // the 'end' keyword is the end for the case block and the record block
+          UndoReadNextAtom;
+        end;
         BlockType:=bkwNone;
         if ReadOnlyOneBlock then break;
       end
@@ -1172,7 +1268,7 @@ begin
       else
       if ((BlockType in [bkwBegin,bkwRepeat,bkwTry,bkwFinally,bkwExcept,
           bkwCase])
-        and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase]))
+        and (CurBlockWord in [bkwBegin,bkwRepeat,bkwTry,bkwCase,bkwAsm]))
       or ((BlockType in [bkwClass,bkwInterface,bkwDispInterface,bkwObject,
           bkwRecord])
         and (CurBlockWord in [bkwRecord])) then
@@ -1186,6 +1282,10 @@ begin
         // variant record
       end
       else
+      if (BlockType=bkwClass) and (CurBlockWord=bkwClass) then begin
+        // class method
+      end
+      else
       begin
         // unexpected keyword found
         if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos)
@@ -1202,18 +1302,6 @@ begin
   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)