/ide/abstractsmethodsdlg.pas

  1{
  2 ***************************************************************************
  3 *                                                                         *
  4 *   This source is free software; you can redistribute it and/or modify   *
  5 *   it under the terms of the GNU General Public License as published by  *
  6 *   the Free Software Foundation; either version 2 of the License, or     *
  7 *   (at your option) any later version.                                   *
  8 *                                                                         *
  9 *   This code is distributed in the hope that it will be useful, but      *
 10 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 11 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 12 *   General Public License for more details.                              *
 13 *                                                                         *
 14 *   A copy of the GNU General Public License is available on the World    *
 15 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 16 *   obtain it by writing to the Free Software Foundation,                 *
 17 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 18 *                                                                         *
 19 ***************************************************************************
 20
 21  Author: Mattias Gaertner
 22
 23  Abstract:
 24    A dialog showing the abstract methods of the current class
 25    (at cursor in source editor).
 26    With the ability to implement them automatically by adding empty method
 27    stubs.
 28}
 29unit AbstractsMethodsDlg;
 30
 31{$mode objfpc}{$H+}
 32
 33interface
 34
 35uses
 36  Classes, SysUtils, LCLProc, Forms, Controls, Graphics, Dialogs,
 37  CheckLst, StdCtrls, ExtCtrls, Buttons,
 38  CodeTree, PascalParserTool, CodeCache, CodeToolManager,
 39  LazIDEIntf, SrcEditorIntf, IDEDialogs,
 40  LazarusIDEStrConsts;
 41
 42type
 43
 44  { TAbstractMethodDlgItem }
 45
 46  TAbstractMethodDlgItem = class
 47  public
 48    CodeXYPos: TCodeXYPosition;
 49    ProcHead: string;
 50    BelongsToStartClass: boolean;
 51  end;
 52
 53  { TAbstractMethodsDialog }
 54
 55  TAbstractMethodsDialog = class(TForm)
 56    AddAllBitBtn: TBitBtn;
 57    NoteLabel: TLabel;
 58    SelectNoneButton: TButton;
 59    SelectAllButton: TButton;
 60    CancelBitBtn: TBitBtn;
 61    AddFirstBitBtn: TBitBtn;
 62    MethodsCheckListBox: TCheckListBox;
 63    MethodsGroupBox: TGroupBox;
 64    BtnPanel: TPanel;
 65    procedure AddAllBitBtnClick(Sender: TObject);
 66    procedure AddFirstBitBtnClick(Sender: TObject);
 67    procedure FormCreate(Sender: TObject);
 68    procedure FormDestroy(Sender: TObject);
 69    procedure MethodsCheckListBoxClickCheck(Sender: TObject);
 70    procedure SelectAllButtonClick(Sender: TObject);
 71    procedure SelectNoneButtonClick(Sender: TObject);
 72  private
 73    CodePos: TCodeXYPosition;
 74    TopLine: integer;
 75    FItems: TFPList;// list of TAbstractMethodDlgItem
 76    FCheckingSelection: boolean;
 77    procedure ClearItems;
 78    procedure UpdateButtons;
 79    function CheckSelection: boolean;
 80    function AddOverrides(OnlyFirst: boolean): boolean;
 81  public
 82    NewCode: TCodeBuffer;
 83    NewX,NewY,NewTopLine: integer;
 84    procedure Init(aListOfPCodeXYPosition: TFPList; aCode: TCodeBuffer;
 85                   const aCaret: TPoint; aTopLine: integer);
 86  end;
 87
 88function ShowAbstractMethodsDialog: TModalResult;
 89
 90implementation
 91
 92{$R *.lfm}
 93
 94function ShowAbstractMethodsDialog: TModalResult;
 95var
 96  AbstractMethodsDialog: TAbstractMethodsDialog;
 97  SrcEdit: TSourceEditorInterface;
 98  Code: TCodeBuffer;
 99  Caret: TPoint;
100  ErrMsg: String;
101  ListOfPCodeXYPosition: TFPList;
102begin
103  Result:=mrCancel;
104  ListOfPCodeXYPosition:=nil;
105  try
106    // init codetools
107    ErrMsg:=lisSAMIDEIsBusy;
108    if not LazarusIDE.BeginCodeTools then exit;
109    
110    // get cursor position
111    ErrMsg:=lisSAMCursorIsNotInAClassDeclaration;
112    SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
113    if SrcEdit=nil then exit;
114    Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
115    if Code=nil then exit;
116    Caret:=SrcEdit.CursorTextXY;
117    
118    // check cursor is in a class
119    if not CodeToolBoss.FindAbstractMethods(Code,Caret.X,Caret.Y,
120      ListOfPCodeXYPosition,true) then
121    begin
122      DebugLn(['ShowAbstractMethodsDialog CodeToolBoss.FindAbstractMethods failed']);
123      if CodeToolBoss.ErrorMessage<>'' then begin
124        ErrMsg:='';
125        LazarusIDE.DoJumpToCodeToolBossError;
126      end;
127      exit;
128    end;
129
130    // check if there are abstract methods left to override
131    if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then begin
132      ErrMsg:='';
133      IDEMessageDialog(lisSAMNoAbstractMethodsFound,
134        lisSAMThereAreNoAbstractMethodsLeftToOverride
135        ,mtConfirmation,[mbOk]);
136      Result:=mrOk;
137      exit;
138    end;
139
140    ErrMsg:='';
141    AbstractMethodsDialog:=TAbstractMethodsDialog.Create(nil);
142    AbstractMethodsDialog.Init(ListOfPCodeXYPosition,Code,Caret,SrcEdit.TopLine);
143    Result:=AbstractMethodsDialog.ShowModal;
144    AbstractMethodsDialog.Free;
145  finally
146    CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
147    if ErrMsg<>'' then begin
148      IDEMessageDialog(lisCCOErrorCaption,
149        lisSAMUnableToShowAbstractMethodsOfTheCurrentClassBecaus+LineEnding
150        +ErrMsg,mtError,[mbCancel]);
151    end;
152  end;
153end;
154
155{ TAbstractMethodsDialog }
156
157procedure TAbstractMethodsDialog.FormCreate(Sender: TObject);
158begin
159  FItems:=TFPList.Create;
160
161  AddFirstBitBtn.Caption:=lisSAMOverrideFirstSelected;
162  AddAllBitBtn.Caption:=lisSAMOverrideAllSelected;
163  CancelBitBtn.Caption:=lisCancel;
164
165  SelectNoneButton.Caption:=lisSAMSelectNone;
166  SelectAllButton.Caption:=lisMenuSelectAll;
167  MethodsGroupBox.Caption:=lisSAMAbstractMethodsNotYetOverridden;
168end;
169
170procedure TAbstractMethodsDialog.AddFirstBitBtnClick(Sender: TObject);
171begin
172  if not AddOverrides(true) then exit;
173  ModalResult:=mrOk;
174end;
175
176procedure TAbstractMethodsDialog.AddAllBitBtnClick(Sender: TObject);
177begin
178  if not AddOverrides(false) then exit;
179  ModalResult:=mrOk;
180end;
181
182procedure TAbstractMethodsDialog.FormDestroy(Sender: TObject);
183begin
184  ClearItems;
185end;
186
187procedure TAbstractMethodsDialog.MethodsCheckListBoxClickCheck(Sender: TObject);
188begin
189  CheckSelection;
190  UpdateButtons;
191end;
192
193procedure TAbstractMethodsDialog.SelectAllButtonClick(Sender: TObject);
194var
195  i: Integer;
196begin
197  for i:=0 to FItems.Count-1 do
198    MethodsCheckListBox.Checked[i]:=
199      not TAbstractMethodDlgItem(FItems[i]).BelongsToStartClass;
200end;
201
202procedure TAbstractMethodsDialog.SelectNoneButtonClick(Sender: TObject);
203var
204  i: Integer;
205begin
206  for i:=0 to FItems.Count-1 do
207    MethodsCheckListBox.Checked[i]:=false;
208end;
209
210procedure TAbstractMethodsDialog.ClearItems;
211var
212  i: Integer;
213begin
214  if FItems=nil then exit;
215  for i:=0 to FItems.Count-1 do
216    TObject(FItems[i]).Free;
217  FreeAndNil(FItems);
218end;
219
220procedure TAbstractMethodsDialog.UpdateButtons;
221var
222  i: Integer;
223begin
224  i:=MethodsCheckListBox.Items.Count-1;
225  while (i>=0) and (not MethodsCheckListBox.Checked[i]) do dec(i);
226  AddFirstBitBtn.Enabled:=i>=0;
227  AddAllBitBtn.Enabled:=AddFirstBitBtn.Enabled;
228end;
229
230function TAbstractMethodsDialog.CheckSelection: boolean;
231var
232  i: Integer;
233  Item: TAbstractMethodDlgItem;
234begin
235  Result:=true;
236  if FCheckingSelection then exit;
237  FCheckingSelection:=true;
238  try
239    for i:=0 to FItems.Count-1 do begin
240      Item:=TAbstractMethodDlgItem(FItems[i]);
241      if MethodsCheckListBox.Checked[i] and Item.BelongsToStartClass then begin
242        if Result then begin
243          IDEMessageDialog(lisCCOErrorCaption,
244            lisSAMThisMethodCanNotBeOverriddenBecauseItIsDefinedInTh,
245            mtError,[mbCancel]);
246          Result:=false;
247        end;
248        MethodsCheckListBox.Checked[i]:=false;
249      end;
250    end;
251  finally
252    FCheckingSelection:=false;
253  end;
254end;
255
256function TAbstractMethodsDialog.AddOverrides(OnlyFirst: boolean): boolean;
257var
258  i: Integer;
259  NewList: TFPList;
260  Item: TAbstractMethodDlgItem;
261begin
262  Result:=false;
263  if not CheckSelection then exit;
264  NewList:=nil;
265  try
266    for i:=0 to FItems.Count-1 do begin
267      if not MethodsCheckListBox.Checked[i] then continue;
268      Item:=TAbstractMethodDlgItem(FItems[i]);
269      AddCodePosition(NewList,Item.CodeXYPos);
270      DebugLn(['TAbstractMethodsDialog.AddOverrides ',Item.CodeXYPos.Code.Filename,' ',Item.CodeXYPos.X,',',Item.CodeXYPos.Y]);
271      if OnlyFirst then break;
272    end;
273    
274    //DebugLn(['TAbstractMethodsDialog.AddOverrides ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
275    if not CodeToolBoss.AddMethods(CodePos.Code,CodePos.X,CodePos.Y,TopLine,
276      NewList,true,NewCode,NewX,NewY,NewTopLine)
277    then begin
278      LazarusIDE.DoJumpToCodeToolBossError;
279      exit;
280    end;
281    
282    LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),
283                                      NewTopLine,-1,-1,[]);
284  finally
285    CodeToolBoss.FreeListOfPCodeXYPosition(NewList);
286  end;
287
288  Result:=true;
289end;
290
291procedure TAbstractMethodsDialog.Init(aListOfPCodeXYPosition: TFPList;
292  aCode: TCodeBuffer; const aCaret: TPoint; aTopLine: integer);
293var
294  i: Integer;
295  CodeXYPos: TCodeXYPosition;
296  CurTool: TCodeTool;
297  ListOfPCodeXYPosition: TFPList;
298  Tool: TCodeTool;
299  CleanPos: integer;
300  ClassNode: TCodeTreeNode;
301  CurNode: TCodeTreeNode;
302  ProcNode: TCodeTreeNode;
303  NewItem: TAbstractMethodDlgItem;
304  StartClassName: String;
305  BelongsToStartClassCnt: Integer;
306  NoteStr: String;
307begin
308  ListOfPCodeXYPosition:=aListOfPCodeXYPosition;
309  if ListOfPCodeXYPosition=nil then begin
310    DebugLn(['TAbstractMethodsDialog.Init ListOfPCodeXYPosition=nil']);
311    exit;
312  end;
313  CodePos.Code:=aCode;
314  CodePos.X:=aCaret.X;
315  CodePos.Y:=aCaret.Y;
316  TopLine:=aTopLine;
317
318  // get Tool and ClassNode
319  Tool:=CodeToolBoss.GetCodeToolForSource(CodePos.Code,true,false) as TCodeTool;
320  if Tool.CaretToCleanPos(CodePos,CleanPos)<>0 then begin
321    DebugLn(['TAbstractMethodsDialog.Init invalid ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
322    exit;
323  end;
324  ClassNode:=Tool.FindDeepestNodeAtPos(CleanPos,false);
325  if ClassNode=nil then begin
326    DebugLn(['TAbstractMethodsDialog.Init no node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
327    exit;
328  end;
329  if ClassNode.Desc=ctnTypeDefinition then
330    ClassNode:=ClassNode.FirstChild
331  else if ClassNode.Desc=ctnGenericType then
332    ClassNode:=ClassNode.LastChild
333  else
334    ClassNode:=Tool.FindClassOrInterfaceNode(ClassNode);
335  if (ClassNode=nil) then begin
336    DebugLn(['TAbstractMethodsDialog.Init no class node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
337    exit;
338  end;
339  
340  StartClassName:=Tool.ExtractClassName(ClassNode,false);
341  BelongsToStartClassCnt:=0;
342
343  // create items
344  for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
345    CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
346    CurTool:=CodeToolBoss.GetCodeToolForSource(CodeXYPos.Code,true,false) as TCodeTool;
347    if CurTool.CaretToCleanPos(CodeXYPos,CleanPos)<>0 then begin
348      DebugLn(['TAbstractMethodsDialog.Init skipping ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
349      continue;
350    end;
351    CurNode:=CurTool.FindDeepestNodeAtPos(CleanPos,false);
352    if CurNode=nil then begin
353      DebugLn(['TAbstractMethodsDialog.Init no node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
354      continue;
355    end;
356    if CurNode.Desc<>ctnProcedure then begin
357      DebugLn(['TAbstractMethodsDialog.Init no proc node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
358      continue;
359    end;
360    ProcNode:=CurNode;
361    NewItem:=TAbstractMethodDlgItem.Create;
362    NewItem.CodeXYPos:=CodeXYPos;
363    NewItem.ProcHead:=CurTool.ExtractProcHead(ProcNode,[phpAddClassname,
364      phpWithStart,phpWithParameterNames,phpWithVarModifiers,
365      phpWithDefaultValues,phpWithResultType,
366      phpWithOfObject,phpWithCallingSpecs]);
367    NewItem.BelongsToStartClass:=ProcNode.HasAsParent(ClassNode);
368    if NewItem.BelongsToStartClass then
369      inc(BelongsToStartClassCnt);
370    FItems.Add(NewItem);
371  end;
372  
373  MethodsCheckListBox.Clear;
374  for i:=0 to FItems.Count-1 do begin
375    NewItem:=TAbstractMethodDlgItem(FItems[i]);
376    MethodsCheckListBox.Items.Add(NewItem.ProcHead);
377    MethodsCheckListBox.Checked[i]:=not NewItem.BelongsToStartClass;
378  end;
379
380  // caption
381  Caption:=Format(lisSAMAbstractMethodsOf, [StartClassName]);
382  
383  // note
384  NoteStr:='';
385  if BelongsToStartClassCnt>0 then begin
386    NoteStr:=Format(lisSAMIsAnAbstractClassItHasAbstractMethods,
387                  [StartClassName, IntToStr(BelongsToStartClassCnt)])+LineEnding;
388  end;
389  NoteStr:=NoteStr+
390    Format(lisSAMThereAreAbstractMethodsToOverrideSelectTheMethodsF,
391           [IntToStr(FItems.Count-BelongsToStartClassCnt), LineEnding]);
392  NoteLabel.Caption:=NoteStr;
393  
394  UpdateButtons;
395end;
396
397end.
398
399