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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, 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 }
29 unit AbstractsMethodsDlg;
30 
31 {$mode objfpc}{$H+}
32 
33 interface
34 
35 uses
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 
42 type
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;
CheckSelectionnull79     function CheckSelection: boolean;
AddOverridesnull80     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 
ShowAbstractMethodsDialognull88 function ShowAbstractMethodsDialog: TModalResult;
89 
90 implementation
91 
92 {$R *.lfm}
93 
ShowAbstractMethodsDialognull94 function ShowAbstractMethodsDialog: TModalResult;
95 var
96   AbstractMethodsDialog: TAbstractMethodsDialog;
97   SrcEdit: TSourceEditorInterface;
98   Code: TCodeBuffer;
99   Caret: TPoint;
100   ErrMsg: String;
101   ListOfPCodeXYPosition: TFPList;
102 begin
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;
153 end;
154 
155 { TAbstractMethodsDialog }
156 
157 procedure TAbstractMethodsDialog.FormCreate(Sender: TObject);
158 begin
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;
168 end;
169 
170 procedure TAbstractMethodsDialog.AddFirstBitBtnClick(Sender: TObject);
171 begin
172   if not AddOverrides(true) then exit;
173   ModalResult:=mrOk;
174 end;
175 
176 procedure TAbstractMethodsDialog.AddAllBitBtnClick(Sender: TObject);
177 begin
178   if not AddOverrides(false) then exit;
179   ModalResult:=mrOk;
180 end;
181 
182 procedure TAbstractMethodsDialog.FormDestroy(Sender: TObject);
183 begin
184   ClearItems;
185 end;
186 
187 procedure TAbstractMethodsDialog.MethodsCheckListBoxClickCheck(Sender: TObject);
188 begin
189   CheckSelection;
190   UpdateButtons;
191 end;
192 
193 procedure TAbstractMethodsDialog.SelectAllButtonClick(Sender: TObject);
194 var
195   i: Integer;
196 begin
197   for i:=0 to FItems.Count-1 do
198     MethodsCheckListBox.Checked[i]:=
199       not TAbstractMethodDlgItem(FItems[i]).BelongsToStartClass;
200 end;
201 
202 procedure TAbstractMethodsDialog.SelectNoneButtonClick(Sender: TObject);
203 var
204   i: Integer;
205 begin
206   for i:=0 to FItems.Count-1 do
207     MethodsCheckListBox.Checked[i]:=false;
208 end;
209 
210 procedure TAbstractMethodsDialog.ClearItems;
211 var
212   i: Integer;
213 begin
214   if FItems=nil then exit;
215   for i:=0 to FItems.Count-1 do
216     TObject(FItems[i]).Free;
217   FreeAndNil(FItems);
218 end;
219 
220 procedure TAbstractMethodsDialog.UpdateButtons;
221 var
222   i: Integer;
223 begin
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;
228 end;
229 
TAbstractMethodsDialog.CheckSelectionnull230 function TAbstractMethodsDialog.CheckSelection: boolean;
231 var
232   i: Integer;
233   Item: TAbstractMethodDlgItem;
234 begin
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;
254 end;
255 
TAbstractMethodsDialog.AddOverridesnull256 function TAbstractMethodsDialog.AddOverrides(OnlyFirst: boolean): boolean;
257 var
258   i, BlockTopLine, BlockBottomLine: Integer;
259   NewList: TFPList;
260   Item: TAbstractMethodDlgItem;
261 begin
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,BlockTopLine,BlockBottomLine)
277     then begin
278       LazarusIDE.DoJumpToCodeToolBossError;
279       exit;
280     end;
281 
282     LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),
283                                       NewTopLine,BlockTopLine,BlockBottomLine,-1,-1,[]);
284   finally
285     CodeToolBoss.FreeListOfPCodeXYPosition(NewList);
286   end;
287 
288   Result:=true;
289 end;
290 
291 procedure TAbstractMethodsDialog.Init(aListOfPCodeXYPosition: TFPList;
292   aCode: TCodeBuffer; const aCaret: TPoint; aTopLine: integer);
293 var
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;
307 begin
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;
395 end;
396 
397 end.
398 
399 
400