MG: improved method completion: add inherited code on override specifier

git-svn-id: trunk@1521 -
2025-09-12 09:39:16 +02:00 · 2002-03-16 10:38:52 +00:00 · 2002-03-16 10:38:52 +00:00 · cda51ae148
commit cda51ae148
parent 274decf5f1
6 changed files with 263 additions and 75 deletions
--- a/components/codetools/basiccodetools.pas
+++ b/components/codetools/basiccodetools.pas
@ -1116,9 +1116,9 @@ var LineStart: integer;
 begin
  Result:=0;
  LineStart:=Position;
-  if (LineStart<0) then LineStart:=1;
-  if (LineStart>length(Source)) then LineStart:=length(Source);
  if LineStart=0 then exit;
+  if (LineStart<0) then LineStart:=1;
+  if (LineStart>length(Source)+1) then LineStart:=length(Source)+1;
  // search beginning of line
  repeat
    dec(LineStart);
--- a/components/codetools/codecompletiontool.pas
+++ b/components/codetools/codecompletiontool.pas
@ -53,6 +53,7 @@ type
  private
    ASourceChangeCache: TSourceChangeCache;
    ClassNode, StartNode: TCodeTreeNode;
+    FAddInheritedCodeToOverrideMethod: boolean;
    FCompleteProperties: boolean;
    FirstInsert: TCodeTreeNodeExtension;
    FSetPropertyVariablename: string;
@ -66,6 +67,9 @@ type
    function CompleteProperty(PropNode: TCodeTreeNode): boolean;
    procedure InsertNewClassParts(PartType: NewClassPart);
    function InsertAllNewClassParts: boolean;
+    procedure AddNewPropertyAccessMethodsToClassProcs(ClassProcs: TAVLTree;
+        const TheClassName: string);
+    procedure CheckForOverrideAndAddInheritedCode(ClassProcs: TAVLTree);
    function CreateMissingProcBodies: boolean;
  public
    function CompleteCode(CursorPos: TCodeXYPosition;
@ -76,6 +80,8 @@ type
      read FSetPropertyVariablename write FSetPropertyVariablename;
    property CompleteProperties: boolean
      read FCompleteProperties write FCompleteProperties;
+    property AddInheritedCodeToOverrideMethod: boolean
+      read FAddInheritedCodeToOverrideMethod write FAddInheritedCodeToOverrideMethod;
  end;


@ -779,6 +785,70 @@ begin
  Result:=true;
 end;

+procedure TCodeCompletionCodeTool.AddNewPropertyAccessMethodsToClassProcs(
+  ClassProcs: TAVLTree;  const TheClassName: string);
+var ANodeExt: TCodeTreeNodeExtension;
+  NewNodeExt: TCodeTreeNodeExtension;
+begin
+  // add new property access methods to ClassProcs
+  ANodeExt:=FirstInsert;
+  while ANodeExt<>nil do begin
+    if not NodeExtIsVariable(ANodeExt) then begin
+      if FindNodeInTree(ClassProcs,ANodeExt.Txt)=nil then begin
+        NewNodeExt:=TCodeTreeNodeExtension.Create;
+        with NewNodeExt do begin
+          Txt:=UpperCaseStr(TheClassName)+'.'
+                +ANodeExt.Txt;       // Name+ParamTypeList
+          ExtTxt1:=ASourceChangeCache.BeautifyCodeOptions.AddClassAndNameToProc(
+             ANodeExt.ExtTxt1,TheClassName,''); // complete proc head code
+          ExtTxt3:=ANodeExt.ExtTxt3;
+          Position:=ANodeExt.Position;
+        end;
+        ClassProcs.Add(NewNodeExt);
+      end;
+    end;
+    ANodeExt:=ANodeExt.Next;
+  end;
+end;
+
+procedure TCodeCompletionCodeTool.CheckForOverrideAndAddInheritedCode(
+  ClassProcs: TAVLTree);
+// check for 'override' directive and add 'inherited' code to body
+var AnAVLNode: TAVLTreeNode;
+  ANodeExt: TCodeTreeNodeExtension;
+  ProcCode, ProcCall: string;
+  ProcNode: TCodeTreeNode;
+  i: integer;
+  BeautifyCodeOptions: TBeautifyCodeOptions;
+begin
+  if not AddInheritedCodeToOverrideMethod then exit;
+  BeautifyCodeOptions:=ASourceChangeCache.BeautifyCodeOptions;
+  AnAVLNode:=ClassProcs.FindLowest;
+  while AnAVLNode<>nil do begin
+    ANodeExt:=TCodeTreeNodeExtension(AnAVLNode.Data);
+    ProcNode:=ANodeExt.Node;
+    if (ProcNode<>nil) and (ANodeExt.ExtTxt3='')
+    and (ProcNodeHasSpecifier(ProcNode,psOVERRIDE)) then begin
+      ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,phpWithoutClassKeyword,
+                      phpAddClassname,phpWithVarModifiers,phpWithParameterNames,
+                      phpWithResultType]);
+      ProcCall:='inherited '+ExtractProcHead(ProcNode,[phpWithoutClassName,
+                                   phpWithParameterNames,phpWithoutParamTypes]);
+      for i:=1 to length(ProcCall)-1 do
+        if ProcCall[i]=';' then ProcCall[i]:=',';
+      if ProcCall[length(ProcCall)]<>';' then
+        ProcCall:=ProcCall+';';
+      ProcCode:=ProcCode+BeautifyCodeOptions.LineEnd
+                  +'begin'+BeautifyCodeOptions.LineEnd
+                  +GetIndentStr(BeautifyCodeOptions.Indent)
+                    +ProcCall+BeautifyCodeOptions.LineEnd
+                  +'end;';
+      ANodeExt.ExtTxt3:=ProcCode;
+    end;
+    AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
+  end;
+end;
+
 function TCodeCompletionCodeTool.CreateMissingProcBodies: boolean;
 var
  Indent, InsertPos: integer;
@ -808,7 +878,7 @@ writeln('>>> InsertProcBody ',TheClassName,' "',ProcCode,'"');

 var
  ProcBodyNodes, ClassProcs: TAVLTree;
-  ANodeExt, ANodeExt2, NewNodeExt: TCodeTreeNodeExtension;
+  ANodeExt, ANodeExt2: TCodeTreeNodeExtension;
  ExistingNode, MissingNode, AnAVLNode, NextAVLNode,
  NearestAVLNode: TAVLTreeNode;
  cmp, MissingNodePosition: integer;
@ -896,32 +966,22 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
      AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
    end;}
    
-    // add new property access methods to ClassProcs
-    ANodeExt:=FirstInsert;
-    while ANodeExt<>nil do begin
-      if not NodeExtIsVariable(ANodeExt) then begin
-        if FindNodeInTree(ClassProcs,ANodeExt.Txt)=nil then begin
-          NewNodeExt:=TCodeTreeNodeExtension.Create;
-          with NewNodeExt do begin
-            Txt:=UpperCaseStr(TheClassName)+'.'
-                  +ANodeExt.Txt;       // Name+ParamTypeList
-            ExtTxt1:=ASourceChangeCache.BeautifyCodeOptions.AddClassAndNameToProc(
-               ANodeExt.ExtTxt1,TheClassName,''); // complete proc head code
-            ExtTxt3:=ANodeExt.ExtTxt3;
-            Position:=ANodeExt.Position;
-          end;
-          ClassProcs.Add(NewNodeExt);
-        end;
-      end;
-      ANodeExt:=ANodeExt.Next;
-    end;
-    
+    AddNewPropertyAccessMethodsToClassProcs(ClassProcs,TheClassName);
+
    {AnAVLNode:=ClassProcs.FindLowest;
    while AnAVLNode<>nil do begin
      writeln(' BBB ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
      AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
    end;}
-    
+
+    CheckForOverrideAndAddInheritedCode(ClassProcs);
+
+    {AnAVLNode:=ClassProcs.FindLowest;
+    while AnAVLNode<>nil do begin
+      writeln(' BBB ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
+      AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
+    end;}
+
    if MethodInsertPolicy=mipClassOrder then begin
      // insert in ClassOrder -> get a definition position for every method
      AnAVLNode:=ClassProcs.FindLowest;
@ -1005,7 +1065,7 @@ writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method
        end;
        if ProcCode<>'' then begin
          ProcCode:=ASourceChangeCache.BeautifyCodeOptions.BeautifyProc(
-                     ProcCode,Indent,true);
+                     ProcCode,Indent,ANodeExt.ExtTxt3='');
          ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,
            InsertPos,ProcCode);
          if JumpToProcName='' then begin
@ -1362,6 +1422,7 @@ begin
  inherited Create;
  FSetPropertyVariablename:='AValue';
  FCompleteProperties:=true;
+  FAddInheritedCodeToOverrideMethod:=true;
 end;


--- a/components/codetools/codetree.pas
+++ b/components/codetools/codetree.pas
@ -141,6 +141,25 @@ const
  ctnsForwardDeclaration = 1;
  ctnsNeedJITParsing     = 2;
  ctnsHasDefaultValue    = 4;
+
+  
+type
+  // Procedure Specifiers
+  TProcedureSpecifier = (
+    psSTDCALL, psREGISTER, psPOPSTACK, psVIRTUAL, psABSTRACT, psDYNAMIC,
+    psOVERLOAD, psOVERRIDE, psREINTRODUCE, psCDECL, psINLINE, psMESSAGE,
+    psEXTERNAL, psFORWARD, psPASCAL, psASSEMBLER, psSAVEREGISTERS,
+    psFAR, psNEAR, psEdgedBracket);
+  TAllProcedureSpecifiers = set of TProcedureSpecifier;
+
+const
+  ProcedureSpecifierNames: array[TProcedureSpecifier] of shortstring = (
+      'STDCALL', 'REGISTER', 'POPSTACK', 'VIRTUAL', 'ABSTRACT', 'DYNAMIC',
+      'OVERLOAD', 'OVERRIDE', 'REINTRODUCE', 'CDECL', 'INLINE', 'MESSAGE',
+      'EXTERNAL', 'FORWARD', 'PASCAL', 'ASSEMBLER', 'SAVEREGISTERS',
+      'FAR', 'NEAR', '['
+    );
+
  
 type
  TCodeTreeNode = class
@ -220,6 +239,7 @@ function NodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string;
 function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer;
 function CompareCodeTreeNodeExtWithPos(NodeData1, NodeData2: pointer): integer;

+
 implementation


--- a/components/codetools/keywordfunclists.pas
+++ b/components/codetools/keywordfunclists.pas
@ -549,16 +549,6 @@ begin
    Add('NEAR'    ,{$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
@ -570,6 +560,16 @@ begin
    Add('FAR'     ,{$ifdef FPC}@{$endif}AllwaysTrue);
    Add('NEAR'    ,{$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;
  IsKeyWordSection:=TKeyWordFunctionList.Create;
  KeyWordLists.Add(IsKeyWordSection);
  with IsKeyWordSection do begin
--- a/components/codetools/pascalparsertool.pas
+++ b/components/codetools/pascalparsertool.pas
@ -73,30 +73,39 @@ type
  end;

  TProcHeadAttribute = (
+      // extract attributes:
      phpWithStart,          // proc keyword e.g. 'function', 'class procedure'
      phpWithoutClassKeyword,// without 'class' proc keyword
+      phpWithoutName,        // skip function name
      phpAddClassname,       // extract/add 'ClassName.'
      phpWithoutClassName,   // skip classname
-      phpWithoutName,        // skip function name
-      phpWithVarModifiers,   // extract 'var', 'out', 'const'
      phpWithoutParamList,   // skip param list
+      phpWithVarModifiers,   // extract 'var', 'out', 'const'
      phpWithParameterNames, // extract parameter names
+      phpWithoutParamTypes,  // skip colon, param types and default values
      phpWithDefaultValues,  // extract default values
      phpWithResultType,     // extract colon + result type
      phpWithOfObject,       // extract 'of object'
      phpWithComments,       // extract comments
      phpInUpperCase,        // turn to uppercase
      phpCommentsToSpace,    // replace comments with a single space
+                             //   (normally unnecessary space is skipped)
      phpWithoutBrackets,    // skip start- and end-bracket of parameter list
+      // search attributes:
      phpIgnoreForwards,     // skip forward procs
      phpIgnoreProcsWithBody,// skip procs with begin..end
      phpIgnoreMethods,      // skip method bodies and definitions
      phpOnlyWithClassname,  // skip procs without the right classname
      phpFindCleanPosition,  // read til ExtractSearchPos
+      // parse attributes:
      phpCreateNodes         // create nodes during reading
    );
  TProcHeadAttributes = set of TProcHeadAttribute;
  
+  TParseProcHeadAttribute = (pphIsMethod, pphIsFunction, pphIsType,
+     pphIsOperator, pphCreateNodes);
+  TParseProcHeadAttributes =  set of TParseProcHeadAttribute;
+  
  TProcHeadExtractPos = (phepNone, phepStart, phepName, phepParamList,
    phepResultType);

@ -158,8 +167,7 @@ type
    procedure BuildClassVarTypeKeyWordFunctions; virtual;
    function UnexpectedKeyWord: boolean;
    // read functions
-    function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType, IsOperator,
-        CreateNodes: boolean;
+    function ReadTilProcedureHeadEnd(ParseAttr: TParseProcHeadAttributes;
        var HasForwardModifier: boolean): boolean;
    function ReadConstant(ExceptionOnError, Extract: boolean;
        Attr: TProcHeadAttributes): boolean;
@ -230,6 +238,11 @@ type
        NodeDesc: TCodeTreeNodeDesc): boolean;
    function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
    function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
+    procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
+    function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
+        ProcSpec: TProcedureSpecifier): boolean;
+    function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
+        ProcSpec: TProcedureSpecifier): boolean;

    constructor Create;
    destructor Destroy; override;
@ -790,12 +803,15 @@ function TPascalParserTool.KeyWordFuncClassVarTypeProc: boolean;
    procedure (a: char) of object;
 }
 var IsFunction, HasForwardModifier: boolean;
+  ParseAttr: TParseProcHeadAttributes;
 begin
 //writeln('[TPascalParserTool.KeyWordFuncClassVarTypeProc]');
  IsFunction:=UpAtomIs('FUNCTION');
  ReadNextAtom;
  HasForwardModifier:=false;
-  ReadTilProcedureHeadEnd(true,IsFunction,true,false,false,HasForwardModifier);
+  ParseAttr:=[pphIsMethod,pphIsType];
+  if IsFunction then Include(ParseAttr,pphIsFunction);
+  ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
  Result:=true;
 end;

@ -848,6 +864,7 @@ function TPascalParserTool.KeyWordFuncClassMethod: boolean;
   message <id or number>
 }
 var IsFunction, HasForwardModifier: boolean;
+  ParseAttr: TParseProcHeadAttributes;
 begin
  HasForwardModifier:=false;
  // create class method node
@ -875,7 +892,9 @@ begin
  CurNode.SubDesc:=ctnsNeedJITParsing;
  // read rest
  ReadNextAtom;
-  ReadTilProcedureHeadEnd(true,IsFunction,false,false,false,HasForwardModifier);
+  ParseAttr:=[pphIsMethod];
+  if IsFunction then Include(ParseAttr,pphIsFunction);
+  ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
  // close procedure header
  CurNode.EndPos:=CurPos.EndPos;
  EndChildNode;
@ -946,7 +965,7 @@ begin
      if not Extract then
        ReadNextAtom
      else
-        ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
+        ExtractNextAtom([phpWithoutParamList,phpWithoutParamTypes]*Attr=[],Attr);
      if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
      if AtomIsChar('=') then begin
        // read default value
@ -1016,7 +1035,9 @@ end;

 function TPascalParserTool.ReadParamType(ExceptionOnError, Extract: boolean;
  Attr: TProcHeadAttributes): boolean;
+var copying: boolean;
 begin
+  copying:=[phpWithoutParamList,phpWithoutParamTypes]*Attr=[];
  Result:=false;
  if AtomIsWord then begin
    if UpAtomIs('ARRAY') then begin
@ -1024,12 +1045,12 @@ begin
        CreateChildNode;
        CurNode.Desc:=ctnArrayType;
      end;
-      if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
+      if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr);
      if not UpAtomIs('OF') then
        if ExceptionOnError then
          RaiseException('''of'' expected, but '+GetAtom+' found')
        else exit;
-      ReadNextAtom;
+      if not Extract then ReadNextAtom else ExtractNextAtom(copying,Attr);
      if UpAtomIs('CONST') then begin
        if (phpCreateNodes in Attr) then begin
          CreateChildNode;
@ -1040,7 +1061,7 @@ begin
        if not Extract then
          ReadNextAtom
        else
-          ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
+          ExtractNextAtom(copying,Attr);
        Result:=true;
        exit;
      end;
@ -1055,7 +1076,7 @@ begin
    if not Extract then
      ReadNextAtom
    else
-      ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
+      ExtractNextAtom(copying,Attr);
  end else begin
    if ExceptionOnError then
      RaiseException(
@ -1066,7 +1087,7 @@ begin
 end;

 function TPascalParserTool.ReadTilProcedureHeadEnd(
-  IsMethod, IsFunction, IsType, IsOperator, CreateNodes: boolean;
+  ParseAttr: TParseProcHeadAttributes;
  var HasForwardModifier: boolean): boolean;
 { parse parameter list, result type, of object, method specifiers

@ -1103,14 +1124,14 @@ begin
  HasForwardModifier:=false;
  if AtomIsChar('(') then begin
    Attr:=[];
-    if CreateNodes then
+    if pphCreateNodes in ParseAttr then
      Include(Attr,phpCreateNodes);
    ReadParamList(true,false,Attr);
  end;
-  if IsOperator and (not AtomIsChar(':')) then begin
+  if (pphIsOperator in ParseAttr) and (not AtomIsChar(':')) then begin
    // read operator result identifier
    AtomIsIdentifier(true);
-    if CreateNodes then begin
+    if (pphCreateNodes in ParseAttr) then begin
      CreateChildNode;
      CurNode.Desc:=ctnVarDefinition;
      CurNode.EndPos:=CurPos.EndPos;
@ -1118,12 +1139,12 @@ begin
    end;
    ReadNextAtom;
  end;
-  if IsFunction or IsOperator then begin
+  if ([pphIsFunction,pphIsOperator]*ParseAttr<>[]) then begin
    // read function result type
    if AtomIsChar(':') then begin
      ReadNextAtom;
      AtomIsIdentifier(true);
-      if CreateNodes then begin
+      if (pphCreateNodes in ParseAttr) then begin
        CreateChildNode;
        CurNode.Desc:=ctnIdentifier;
        CurNode.EndPos:=CurPos.EndPos;
@ -1137,7 +1158,7 @@ begin
  end;
  if UpAtomIs('OF') then begin
    // read 'of object'
-    if not IsType then
+    if not (pphIsType in ParseAttr) then
      RaiseException(
        '; expected, but '+GetAtom+' found');
    ReadNextAtom;
@ -1155,7 +1176,7 @@ begin
  if (CurPos.StartPos>SrcLen) then
    RaiseException('semicolon not found');
  repeat
-    if IsMethod then
+    if (pphIsMethod in ParseAttr) then
      IsSpecifier:=IsKeyWordMethodSpecifier.DoItUppercase(UpperSrc,
        CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
    else
@ -1574,6 +1595,7 @@ function TPascalParserTool.KeyWordFuncProc: boolean;
 var ChildCreated: boolean;
  IsFunction, HasForwardModifier, IsClassProc, IsOperator: boolean;
  ProcNode: TCodeTreeNode;
+  ParseAttr: TParseProcHeadAttributes;
 begin
  if UpAtomIs('CLASS') then begin
    if CurSection<>ctnImplementation then
@ -1617,8 +1639,10 @@ begin
  end;
  // read rest of procedure head
  HasForwardModifier:=false;
-  ReadTilProcedureHeadEnd(false,IsFunction,false,IsOperator,false,
-                          HasForwardModifier);
+  ParseAttr:=[];
+  if IsFunction then Include(ParseAttr,pphIsFunction);
+  if IsOperator then Include(ParseAttr,pphIsOperator);
+  ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
  if ChildCreated then begin
    if HasForwardModifier then
      ProcNode.SubDesc:=ctnsForwardDeclaration;
@ -3445,8 +3469,88 @@ begin
  Result:=UpAtomIs('DEFAULT');
 end;

+procedure TPascalParserTool.MoveCursorToFirstProcSpecifier(
+  ProcNode: TCodeTreeNode);
+// After the call,
+// CurPos will stand on the first proc specifier or on a semicolon
+begin
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then begin
+    RaiseException('Internal Error in'
+      +' TPascalParserTool.MoveCursorFirstProcSpecifier: '
+      +' (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)');
+  end;
+  MoveCursorToNodeStart(ProcNode.FirstChild);
+  ReadNextAtom;
+  if AtomIsIdentifier(false) then begin
+    // read name
+    ReadNextAtom;
+    if AtomIsChar('.') then begin
+      // read method name
+      ReadNextAtom;
+      ReadNextAtom;
+    end;
+  end;
+  if AtomIsChar('(') then begin
+    // read paramlist
+    ReadTilBracketClose(false);
+    ReadNextAtom;
+  end;
+  if AtomIsChar(':') then begin
+    // read function result type
+    ReadNextAtom;
+    ReadNextAtom;
+  end;
+  // CurPos now stands on the first proc specifier or on a semicolon
+end;
+
+function TPascalParserTool.MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
+  ProcSpec: TProcedureSpecifier): boolean;
+begin
+  MoveCursorToFirstProcSpecifier(ProcNode);
+  while (CurPos.StartPos<=ProcNode.FirstChild.EndPos) do begin
+    if AtomIsChar(';') then begin
+      ReadNextAtom;
+    end else begin
+      if UpAtomIs(ProcedureSpecifierNames[ProcSpec]) then begin
+        Result:=true;
+        exit;
+      end;
+      if AtomIsChar('[') then begin
+        ReadTilBracketClose(false);
+        ReadNextAtom;
+      end else if UpAtomIs('MESSAGE') then begin
+        ReadNextAtom;
+        ReadConstant(true,false,[]);
+      end else if UpAtomIs('EXTERNAL') then begin
+        ReadNextAtom;
+        if not AtomIsChar(';') then begin
+          if not UpAtomIs('NAME') then
+            ReadConstant(true,false,[]);
+          if UpAtomIs('NAME') or UpAtomIs('INDEX') then begin
+            ReadNextAtom;
+            ReadConstant(true,false,[]);
+          end;
+        end;
+      end else begin
+        ReadNextAtom;
+      end;
+    end;
+  end;
+  Result:=false;
+end;
+
+function TPascalParserTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
+  ProcSpec: TProcedureSpecifier): boolean;
+begin
+
+  // ToDo: ppu, ppw, dcu
+
+  Result:=MoveCursorToProcSpecifier(ProcNode,ProcSpec);
+end;
+
 procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode);
-var HasForwardModifier, IsFunction, IsOperator: boolean;
+var HasForwardModifier, IsFunction, IsOperator, IsMethod: boolean;
+  ParseAttr: TParseProcHeadAttributes;
 begin
  if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)
@ -3454,6 +3558,7 @@ begin
    RaiseException('[TPascalParserTool.BuildSubTreeForProcHead] '
      +'internal error: invalid ProcNode');
  if (ProcNode.FirstChild.SubDesc and ctnsNeedJITParsing)=0 then exit;
+  IsMethod:=ProcNode.HasParentOfType(ctnClass);
  MoveCursorToNodeStart(ProcNode);
  ReadNextAtom;
  if UpAtomIs('CLASS') then
@ -3473,8 +3578,11 @@ begin
  end;
  // read rest of procedure head and build nodes
  HasForwardModifier:=false;
-  ReadTilProcedureHeadEnd(false,IsFunction,false,IsOperator,true,
-                          HasForwardModifier);
+  ParseAttr:=[pphCreateNodes];
+  if IsMethod then Include(ParseAttr,pphIsMethod);
+  if IsFunction then Include(ParseAttr,pphIsFunction);
+  if IsOperator then Include(ParseAttr,pphIsOperator);
+  ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
  ProcNode.FirstChild.SubDesc:=ctnsNone;
 end;

--- a/components/codetools/sourcechanger.pas
+++ b/components/codetools/sourcechanger.pas
@ -60,10 +60,11 @@ type
  TBeautifyCodeOptions = class
  private
    CurLineLen: integer;
-    LastSplitPos: integer;
+    LastSplitPos: integer; // last position where splitting is allowed
+    LastSrcLineStart: integer;// last line start, not added by splitting
    CurAtomType, LastAtomType: TAtomType;
-    CurPos, AtomStart, AtomEnd, SrcLen: integer;
-    Src, UpperSrc, IndentStr: string;
+    CurPos, AtomStart, AtomEnd, SrcLen, CurIndent: integer;
+    Src, UpperSrc: string;
    procedure AddAtom(var s:string; NewAtom: string);
    procedure ReadNextAtom;
  public
@ -714,7 +715,8 @@ begin
  and (LastSplitPos>1) then begin
 //writeln('[TBeautifyCodeOptions.AddAtom]  NEW LINE CurLineLen=',CurLineLen,' NewAtom=',NewAtom,' "',copy(s,LastSplitPos,5));
    RestLineLen:=length(s)-LastSplitPos+1;
-    s:=copy(s,1,LastSplitPos-1)+LineEnd+IndentStr
+    s:=copy(s,1,LastSplitPos-1)+LineEnd
+       +GetIndentStr(CurIndent+Indent+GetLineIndent(s,LastSrcLineStart))
       +copy(s,LastSplitPos,RestLineLen)+NewAtom;
    CurLineLen:=length(s)-LastSplitPos-length(LineEnd)+1;
    LastSplitPos:=-1;
@ -722,8 +724,11 @@ begin
    s:=s+NewAtom;
    if LastLineEndInAtom<1 then begin
      inc(CurLineLen,length(NewAtom));
-    end else
+    end else begin
+      // there is a line end in the code
      CurLineLen:=length(NewAtom)-LastLineEndInAtom;
+      LastSrcLineStart:=length(s)+1-CurLineLen;
+    end;
  end;
 end;

@ -862,12 +867,9 @@ function TBeautifyCodeOptions.BeautifyProc(const AProcCode: string;
 begin
  Result:=BeautifyStatement(AProcCode,IndentSize);
  if AddBeginEnd then begin
-    SetLength(IndentStr,IndentSize);
-    if IndentSize>0 then
-      FillChar(IndentStr[1],length(IndentStr),' ');
-    AddAtom(Result,LineEnd+IndentStr);
+    AddAtom(Result,LineEnd+GetIndentStr(IndentSize));
    AddAtom(Result,'begin');
-    AddAtom(Result,LineEnd+LineEnd+IndentStr);
+    AddAtom(Result,LineEnd+LineEnd+GetIndentStr(IndentSize));
    AddAtom(Result,'end;');
  end;
 {$IFDEF CTDEBUG}
@ -885,14 +887,11 @@ begin
  UpperSrc:=UpperCaseStr(Src);
  SrcLen:=length(Src);
  if IndentSize>=LineLength-10 then IndentSize:=LineLength-10;
-  SetLength(Result,IndentSize);
-  if IndentSize>0 then
-    FillChar(Result[1],length(Result),' ');
-  SetLength(IndentStr,IndentSize+Indent);
-  if length(IndentStr)>0 then
-    FillChar(IndentStr[1],length(IndentStr),' ');
+  CurIndent:=IndentSize;
+  Result:=GetIndentStr(CurIndent);
  CurPos:=1;
  LastSplitPos:=-1;
+  LastSrcLineStart:=1;
  CurLineLen:=length(Result);
  LastAtomType:=atNone;
  while (CurPos<=SrcLen) do begin