cody: add call inherited

git-svn-id: trunk@30720 -

.gitattributes

@@ -560,6 +560,7 @@ components/codetools/ide/codyfrm.lfm svneol=native#text/plain
 components/codetools/ide/codyfrm.pas svneol=native#text/plain
 components/codetools/ide/codyregistration.pas svneol=native#text/plain
 components/codetools/ide/codystrconsts.pas svneol=native#text/pascal
+components/codetools/ide/codyutils.pas svneol=native#text/pascal
 components/codetools/ide/declarevardlg.lfm svneol=native#text/plain
 components/codetools/ide/declarevardlg.pas svneol=native#text/pascal
 components/codetools/ide/languages/codystrconsts.it.po svneol=native#text/plain

components/codetools/ide/cody.lpk

@@ -15,7 +15,7 @@
     <Description Value="IDE extensions using Codetools."/>
     <License Value="GPL2"/>
     <Version Major="1" Release="1"/>
-    <Files Count="7">
+    <Files Count="8">
       <Item1>
         <Filename Value="ppulistdlg.pas"/>
         <UnitName Value="PPUListDlg"/>
@@ -45,6 +45,10 @@
         <Filename Value="declarevardlg.pas"/>
         <UnitName Value="declarevardlg"/>
       </Item7>
+      <Item8>
+        <Filename Value="codyutils.pas"/>
+        <UnitName Value="codyutils"/>
+      </Item8>
     </Files>
     <LazDoc Paths="doc"/>
     <i18n>

components/codetools/ide/cody.pas

@@ -8,7 +8,7 @@ interface
 
 uses
   PPUListDlg, CodyStrConsts, AddAssignMethodDlg, CodyCtrls, CodyFrm, 
-  CodyRegistration, DeclareVarDlg, LazarusPackageIntf;
+  CodyRegistration, DeclareVarDlg, CodyUtils, LazarusPackageIntf;
 
 implementation
 

components/codetools/ide/codyfrm.pas

@@ -34,127 +34,25 @@ interface
 uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   // codetools
-  FileProcs, CodeToolManager, SourceLog, CodeCache,
+  //FileProcs, CodeToolManager, SourceLog, CodeCache, EventCodeTool,
+  //LinkScanner, PascalParserTool, CodeTree,
   // IDEIntf
-  LazIDEIntf, SrcEditorIntf, IDEDialogs,
+  //LazIDEIntf, SrcEditorIntf, IDEDialogs,
   // cody
   CodyStrConsts;
 
 type
 
-  { TCody }
-
-  TCody = class
-  public
-    procedure DecodeLoaded(Sender: TSourceLog; const Filename: string;
-                           var Source, DiskEncoding, MemEncoding: string);
-  end;
-
   TCodyWindow = class(TForm)
   private
   public
   end;
 
 var
-  Cody: TCody;
   CodyWindow: TCodyWindow;
 
-procedure RemoveWithBlockCmd(Sender: TObject);
-procedure InsertFileAtCursor(Sender: TObject);
-
 implementation
 
-procedure RemoveWithBlockCmd(Sender: TObject);
-
-  procedure ErrorNotInWithVar;
-  begin
-    IDEMessageDialog(crsCWError,
-      crsCWPleasePlaceTheCursorOfTheSourceEditorOnAWithVariab,
-      mtError,[mbCancel]);
-  end;
-
-var
-  SrcEdit: TSourceEditorInterface;
-begin
-  // commit changes form source editor to codetools
-  if not LazarusIDE.BeginCodeTools then exit;
-  // check context at cursor
-  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
-  if SrcEdit=nil then begin
-    ErrorNotInWithVar;
-    exit;
-  end;
-  if not CodeToolBoss.RemoveWithBlock(SrcEdit.CodeToolsBuffer as TCodeBuffer,
-    SrcEdit.CursorTextXY.X,SrcEdit.CursorTextXY.Y)
-  then begin
-    // syntax error or not in a class
-    if CodeToolBoss.ErrorMessage<>'' then
-      LazarusIDE.DoJumpToCodeToolBossError
-    else
-      ErrorNotInWithVar;
-    exit;
-  end;
-end;
-
-procedure InsertFileAtCursor(Sender: TObject);
-var
-  OpenDialog: TOpenDialog;
-  Filter: String;
-  Filename: String;
-  Code: TCodeBuffer;
-  SrcEdit: TSourceEditorInterface;
-begin
-  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
-  if SrcEdit=nil then exit;
-
-  OpenDialog:=TOpenDialog.Create(nil);
-  Code:=nil;
-  try
-    InitIDEFileDialog(OpenDialog);
-    OpenDialog.Title:='Select file to insert at cursor';
-    OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist];
-    Filter:='Pascal' + ' (*.pas;*.pp)|*.pas;*.pp';
-    Filter:=Filter+'|'+'All files' + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
-    OpenDialog.Filter:=Filter;
-    if not OpenDialog.Execute then exit;
-    Filename:=OpenDialog.FileName;
-    if not FileIsText(Filename) then begin
-      if IDEMessageDialog('Warning','The file seems to be a binary. Proceed?',
-        mtConfirmation,[mbOk,mbCancel])<>mrOK then exit;
-    end;
-    Code:=TCodeBuffer.Create;
-    Code.Filename:=Filename;
-    Code.OnDecodeLoaded:=@Cody.DecodeLoaded;
-    if not Code.LoadFromFile(Filename) then begin
-      IDEMessageDialog('Error','Unable to load file "'+Filename+'"'#13
-      +Code.LastError,
-        mtError,[mbCancel]);
-      exit;
-    end;
-
-    SrcEdit.Selection:=Code.Source;
-  finally
-    OpenDialog.Free;
-    Code.Free;
-  end;
-end;
-
-{ TCody }
-
-procedure TCody.DecodeLoaded(Sender: TSourceLog; const Filename: string;
-  var Source, DiskEncoding, MemEncoding: string);
-begin
-  //debugln(['TCody.DecodeLoaded ',Filename]);
-  if (Sender is TCodeBuffer)
-  and Assigned(CodeToolBoss.SourceCache.OnDecodeLoaded) then
-    CodeToolBoss.SourceCache.OnDecodeLoaded(TCodeBuffer(Sender),Filename,
-      Source,DiskEncoding,MemEncoding);
-end;
-
-initialization
-  Cody:=TCody.Create;
-finalization
-  FreeAndNil(Cody);
 
 end.
 

components/codetools/ide/codyregistration.pas

@@ -32,8 +32,8 @@ interface
 uses
   Classes, SysUtils,
   IDECommands, MenuIntf,
-  LResources, CodyFrm, CodyStrConsts, CodyCtrls, PPUListDlg, AddAssignMethodDlg,
-  DeclareVarDlg;
+  LResources, CodyStrConsts, CodyCtrls, PPUListDlg, AddAssignMethodDlg,
+  CodyUtils;
 
 procedure Register;
 
@@ -50,6 +50,7 @@ var
   InsertFileAtCursorCommand: TIDECommand;
   //DeclareVariableCommand: TIDECommand;
   TVIconRes: TLResource;
+  AddCallInheritedCommand: TIDECommand;
 begin
   CmdCatFileMenu:=IDECommandList.FindCategoryByName('FileMenu');
   if CmdCatFileMenu=nil then
@@ -75,6 +76,13 @@ begin
   RegisterIDEMenuCommand(itmProjectWindowSection,'PPUList',crsShowUsedPpuFiles,
     nil,nil,PPUListCommand);
 
+  // add call inherited
+  AddCallInheritedCommand:=RegisterIDECommand(CmdCatCodeTools, 'AddCallInherited',
+    crsAddCallInherited,
+    CleanIDEShortCut,CleanIDEShortCut,nil,@AddCallInherited);
+  RegisterIDEMenuCommand(SrcEditSubMenuSource, 'AddCallInherited',
+    crsAddCallInherited, nil, nil, AddCallInheritedCommand);
+
   // declare variable
   {DeclareVariableCommand:=RegisterIDECommand(CmdCatCodeTools, 'DeclareVariable',
     crsDeclareVariable,

components/codetools/ide/codystrconsts.pas

@@ -98,6 +98,7 @@ resourcestring
   crsBTNCancel = 'Cancel';
   crsDeclareVariable = 'Declare Variable';
   crsDeclareVariable2 = 'Declare Variable ...';
+  crsAddCallInherited = 'Add call inherited';
 
 implementation
 

components/codetools/ide/codyutils.pas

@@ -0,0 +1,309 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    Common functions.
+}
+unit CodyUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Dialogs, Controls,
+  // IDEIntf
+  IDEDialogs, LazIDEIntf, SrcEditorIntf,
+  // codetools
+  CodeAtom, FileProcs, CodeToolManager, CodeCache, SourceLog, BasicCodeTools,
+  EventCodeTool, LinkScanner, PascalParserTool, CodeTree, SourceChanger,
+  CodeBeautifier,
+  CodyStrConsts;
+
+type
+  { TCody }
+
+  TCody = class
+  public
+    procedure DecodeLoaded(Sender: TSourceLog; const Filename: string;
+                           var Source, DiskEncoding, MemEncoding: string);
+  end;
+
+var
+  Cody: TCody;
+
+type
+  TCUParseError = (
+    cupeNoSrcEditor,
+    cupeMainCodeNotFound, // the file of the unit start was not found
+    cupeParseError,
+    cupeCursorNotInCode, // e.g. in front of the keyword 'unit'
+    cupeSuccess
+    );
+
+procedure RemoveWithBlockCmd(Sender: TObject);
+procedure InsertFileAtCursor(Sender: TObject);
+procedure AddCallInherited(Sender: TObject);
+
+function ParseTilCursor(out Tool: TCodeTool; out CleanPos: integer;
+   out Node: TCodeTreeNode; out ErrorHandled: boolean;
+   JumpToError: boolean): TCUParseError;
+
+implementation
+
+procedure RemoveWithBlockCmd(Sender: TObject);
+
+  procedure ErrorNotInWithVar;
+  begin
+    IDEMessageDialog(crsCWError,
+      crsCWPleasePlaceTheCursorOfTheSourceEditorOnAWithVariab,
+      mtError,[mbCancel]);
+  end;
+
+var
+  SrcEdit: TSourceEditorInterface;
+begin
+  // commit changes form source editor to codetools
+  if not LazarusIDE.BeginCodeTools then exit;
+  // check context at cursor
+  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
+  if SrcEdit=nil then begin
+    ErrorNotInWithVar;
+    exit;
+  end;
+  if not CodeToolBoss.RemoveWithBlock(SrcEdit.CodeToolsBuffer as TCodeBuffer,
+    SrcEdit.CursorTextXY.X,SrcEdit.CursorTextXY.Y)
+  then begin
+    // syntax error or not in a class
+    if CodeToolBoss.ErrorMessage<>'' then
+      LazarusIDE.DoJumpToCodeToolBossError
+    else
+      ErrorNotInWithVar;
+    exit;
+  end;
+end;
+
+procedure InsertFileAtCursor(Sender: TObject);
+var
+  OpenDialog: TOpenDialog;
+  Filter: String;
+  Filename: String;
+  Code: TCodeBuffer;
+  SrcEdit: TSourceEditorInterface;
+begin
+  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
+  if SrcEdit=nil then exit;
+
+  OpenDialog:=TOpenDialog.Create(nil);
+  Code:=nil;
+  try
+    InitIDEFileDialog(OpenDialog);
+    OpenDialog.Title:='Select file to insert at cursor';
+    OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist];
+    Filter:='Pascal' + ' (*.pas;*.pp)|*.pas;*.pp';
+    Filter:=Filter+'|'+'All files' + ' (' + FileMask + ')|' + FileMask;
+    OpenDialog.Filter:=Filter;
+    if not OpenDialog.Execute then exit;
+    Filename:=OpenDialog.FileName;
+    if not FileIsText(Filename) then begin
+      if IDEMessageDialog('Warning','The file seems to be a binary. Proceed?',
+        mtConfirmation,[mbOk,mbCancel])<>mrOK then exit;
+    end;
+    Code:=TCodeBuffer.Create;
+    Code.Filename:=Filename;
+    Code.OnDecodeLoaded:=@Cody.DecodeLoaded;
+    if not Code.LoadFromFile(Filename) then begin
+      IDEMessageDialog('Error','Unable to load file "'+Filename+'"'#13
+      +Code.LastError,
+        mtError,[mbCancel]);
+      exit;
+    end;
+
+    SrcEdit.Selection:=Code.Source;
+  finally
+    OpenDialog.Free;
+    Code.Free;
+  end;
+end;
+
+procedure AddCallInherited(Sender: TObject);
+
+  procedure ErrorNotInMethod;
+  begin
+    IDEMessageDialog(crsCWError,
+      'Please place the cursor of the source editor in an implementation of an overridden method.',
+      mtError,[mbCancel]);
+  end;
+
+var
+  Handled: boolean;
+  Tool: TEventsCodeTool;
+  CleanPos: integer;
+  CursorNode: TCodeTreeNode;
+  ProcNode: TCodeTreeNode;
+  DeclNode: TCodeTreeNode;
+  NewCode: String;
+  SrcEdit: TSourceEditorInterface;
+  Indent: LongInt;
+  IndentContextSensitive: Boolean;
+  NewIndent: TFABIndentationPolicy;
+  NewLine: Boolean;
+  Gap: TGapTyp;
+begin
+  if (ParseTilCursor(Tool,CleanPos,CursorNode,Handled,true)<>cupeSuccess)
+  and not Handled then begin
+    ErrorNotInMethod;
+    exit;
+  end;
+  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
+  try
+    try
+      ProcNode:=CursorNode.GetNodeOfType(ctnProcedure);
+      if not Tool.NodeIsMethodBody(ProcNode) then begin
+        debugln(['AddCallInherited not in a method body']);
+        exit;
+      end;
+      // search the declaration (the header of the body may be incomplete)
+      DeclNode:=Tool.FindCorrespondingProcNode(ProcNode);
+      if DeclNode=nil then
+        DeclNode:=ProcNode;
+      Handled:=true;
+      NewCode:='inherited '+Tool.ExtractProcHead(DeclNode,
+        [phpWithoutClassName,phpWithParameterNames,phpWithoutParamTypes]);
+      //debugln(['AddCallInherited NewCode="',NewCode,'"']);
+      NewLine:=true;
+      Gap:=gtNone;
+      if Tool.NodeIsFunction(DeclNode) then begin
+        if FindFirstNonSpaceCharInLine(Tool.Src,CleanPos)<CleanPos then begin
+          // insert function behind some code
+          // e.g. InheritedValue:=|
+          Indent:=0;
+          NewLine:=false;
+        end else begin
+          // store the old result value
+          NewCode:='Result:='+NewCode;
+        end;
+      end;
+
+      if NewLine then begin
+        // auto indent
+        Gap:=gtNewLine;
+        Indent:=SrcEdit.CursorScreenXY.X-1;
+        IndentContextSensitive:=true;
+        if CodeToolBoss.Indenter.GetIndent(Tool.Src,CleanPos,
+          Tool.Scanner.NestedComments,
+          true,NewIndent,IndentContextSensitive,NewCode)
+        and NewIndent.IndentValid then begin
+          Indent:=NewIndent.Indent;
+        end;
+        NewCode:=GetIndentStr(Indent)+NewCode;
+        CleanPos:=GetLineStartPosition(Tool.Src,CleanPos);
+        //debugln(['AddCallInherited Indent=',Indent]);
+      end;
+
+      NewCode:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
+        NewCode,Indent,[bcfDoNotIndentFirstLine]);
+      CodeToolBoss.SourceChangeCache.MainScanner:=Tool.Scanner;
+      if not CodeToolBoss.SourceChangeCache.Replace(Gap,Gap,CleanPos,CleanPos,NewCode)
+      then begin
+        debugln(['AddCallInherited CodeToolBoss.SourceChangeCache.Replace failed']);
+        exit;
+      end;
+      if not CodeToolBoss.SourceChangeCache.Apply then begin
+        debugln(['AddCallInherited CodeToolBoss.SourceChangeCache.Apply failed']);
+        exit;
+      end;
+    except
+      on e: Exception do CodeToolBoss.HandleException(e);
+    end;
+  finally
+    // syntax error or not in a method
+    if not Handled then begin
+      if CodeToolBoss.ErrorMessage<>'' then
+        LazarusIDE.DoJumpToCodeToolBossError
+      else
+        ErrorNotInMethod;
+    end;
+  end;
+end;
+
+function ParseTilCursor(out Tool: TCodeTool; out CleanPos: integer;
+  out Node: TCodeTreeNode; out ErrorHandled: boolean;
+  JumpToError: boolean): TCUParseError;
+var
+  SrcEdit: TSourceEditorInterface;
+  CursorPos: TCodeXYPosition;
+begin
+  Tool:=nil;
+  CleanPos:=0;
+  Node:=nil;
+  ErrorHandled:=false;
+  SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
+  if SrcEdit=nil then begin
+    debugln(['CodyUtils.ParseTilCursor: no source editor']);
+    exit(cupeNoSrcEditor);
+  end;
+  CursorPos.Code:=SrcEdit.CodeToolsBuffer as TCodeBuffer;
+  try
+    if not CodeToolBoss.InitCurCodeTool(CursorPos.Code) then
+      exit(cupeMainCodeNotFound);
+    try
+      Tool:=CodeToolBoss.CurCodeTool;
+      CursorPos.X:=SrcEdit.CursorTextXY.X;
+      CursorPos.Y:=SrcEdit.CursorTextXY.Y;
+      Result:=cupeParseError;
+      Tool.BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanPos,
+                                   [btSetIgnoreErrorPos]);
+      Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
+      if Node=nil then
+        exit(cupeCursorNotInCode);
+      Result:=cupeSuccess;
+    except
+      on e: Exception do CodeToolBoss.HandleException(e);
+    end;
+  finally
+    if (CodeToolBoss.ErrorMessage<>'') and JumpToError then begin
+      ErrorHandled:=true;
+      LazarusIDE.DoJumpToCodeToolBossError;
+    end;
+  end;
+end;
+
+{ TCody }
+
+procedure TCody.DecodeLoaded(Sender: TSourceLog; const Filename: string;
+  var Source, DiskEncoding, MemEncoding: string);
+begin
+  //debugln(['TCody.DecodeLoaded ',Filename]);
+  if (Sender is TCodeBuffer)
+  and Assigned(CodeToolBoss.SourceCache.OnDecodeLoaded) then
+    CodeToolBoss.SourceCache.OnDecodeLoaded(TCodeBuffer(Sender),Filename,
+      Source,DiskEncoding,MemEncoding);
+end;
+
+initialization
+  Cody:=TCody.Create;
+finalization
+  FreeAndNil(Cody);
+
+end.
+

components/codetools/ide/languages/codystrconsts.it.po

@@ -18,6 +18,10 @@ msgstr ""
 msgid "Add Assign method ..."
 msgstr ""
 
+#: codystrconsts.crsaddcallinherited
+msgid "Add call inherited"
+msgstr ""
+
 #: codystrconsts.crsbtncancel
 msgid "Cancel"
 msgstr ""

components/codetools/ide/languages/codystrconsts.po

@@ -9,6 +9,10 @@ msgstr ""
 msgid "Add Assign method ..."
 msgstr ""
 
+#: codystrconsts.crsaddcallinherited
+msgid "Add call inherited"
+msgstr ""
+
 #: codystrconsts.crsbtncancel
 msgid "Cancel"
 msgstr ""

components/codetools/ide/languages/codystrconsts.pt_BR.po

@@ -17,6 +17,10 @@ msgstr ""
 msgid "Add Assign method ..."
 msgstr ""
 
+#: codystrconsts.crsaddcallinherited
+msgid "Add call inherited"
+msgstr ""
+
 #: codystrconsts.crsbtncancel
 msgid "Cancel"
 msgstr ""

components/codetools/ide/languages/codystrconsts.ru.po

@@ -17,6 +17,10 @@ msgstr "Добавить метод Assign"
 msgid "Add Assign method ..."
 msgstr "Добавить метод Assign ..."
 
+#: codystrconsts.crsaddcallinherited
+msgid "Add call inherited"
+msgstr ""
+
 #: codystrconsts.crsbtncancel
 msgid "Cancel"
 msgstr "Отмена"

components/codetools/pascalreadertool.pas

@@ -107,7 +107,7 @@ type
     function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
         Attr: TProcHeadAttributes): TCodeTreeNode;
     function FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
-        Attr: TProcHeadAttributes = [phpWithoutClassName,phpWithVarModifiers]
+        Attr: TProcHeadAttributes = [phpWithoutClassKeyword,phpWithoutClassName]
         ): TCodeTreeNode;
     function FindCorrespondingProcParamNode(ProcParamNode: TCodeTreeNode;
         Attr: TProcHeadAttributes = [phpInUpperCase,phpWithoutClassName,phpWithVarModifiers]