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