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 empty methods of the current class
25 (at cursor in source editor).
26 With the ability to remove them automatically.
27 }
28 unit EmptyMethodsDlg;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, TypInfo,
36 // LCL
37 LCLProc, Forms, Controls, Dialogs, StdCtrls, ButtonPanel,
38 // SynEdit
39 SynEdit, SynHighlighterPas,
40 // CodeTools
41 CodeToolsStructs, CodeCache, CodeToolManager, PascalParserTool, CodeTree,
42 // IdeIntf
43 SrcEditorIntf, LazIDEIntf, PropEdits, IDEDialogs,
44 // IDE
45 CustomFormEditor, JitForms, Project, LazarusIDEStrConsts, EditorOptions;
46
47 type
48
49 { TEmptyMethodsDialog }
50
51 TEmptyMethodsDialog = class(TForm)
52 AllButton: TButton;
53 PublishedButton: TButton;
54 ButtonPanel1: TButtonPanel;
55 PrivateCheckBox: TCheckBox;
56 ProtectedCheckBox: TCheckBox;
57 PublicCheckBox: TCheckBox;
58 PublishedCheckBox: TCheckBox;
59 SectionsGroupBox: TGroupBox;
60 MethodsGroupBox: TGroupBox;
61 MethodsSynEdit: TSynEdit;
62 SynPasSyn1: TSynPasSyn;
63 procedure AllButtonClick(Sender: TObject);
64 procedure FormCreate(Sender: TObject);
65 procedure OKButtonClick(Sender: TObject);
66 procedure PrivateCheckBoxChange(Sender: TObject);
67 procedure PublishedButtonClick(Sender: TObject);
68 private
69 FCaret: TPoint;
70 FCode: TCodeBuffer;
GetSectionsnull71 function GetSections: TPascalClassSections;
72 procedure SetCaret(const AValue: TPoint);
73 procedure SetCode(const AValue: TCodeBuffer);
74 procedure SetSections(const AValue: TPascalClassSections);
75 procedure UpdateList;
76 public
77 property Sections: TPascalClassSections read GetSections write SetSections;
78 property Code: TCodeBuffer read FCode write SetCode;
79 property Caret: TPoint read FCaret write SetCaret;
80 end;
81
ShowEmptyMethodsDialognull82 function ShowEmptyMethodsDialog: TModalResult;
83
RemoveEmptyMethodsInUnitnull84 function RemoveEmptyMethodsInUnit(Code: TCodeBuffer; AClassName: string;
85 X, Y: integer; Sections: TPascalClassSections): TModalResult;
86
87
88 implementation
89
90 {$R *.lfm}
91
ShowEmptyMethodsDialognull92 function ShowEmptyMethodsDialog: TModalResult;
93 var
94 EmptyMethodsDialog: TEmptyMethodsDialog;
95 ErrMsg: String;
96 SrcEdit: TSourceEditorInterface;
97 Code: TCodeBuffer;
98 Caret: TPoint;
99 ListOfPCodeXYPosition: TFPList;
100 AllEmpty: boolean;
101 begin
102 Result:=mrCancel;
103 ListOfPCodeXYPosition:=TFPList.Create;
104 try
105 // init codetools
106 ErrMsg:=lisSAMIDEIsBusy;
107 if not LazarusIDE.BeginCodeTools then exit;
108
109 // get cursor position
110 ErrMsg:=lisSAMCursorIsNotInAClassDeclaration;
111 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
112 if SrcEdit=nil then exit;
113 Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
114 if Code=nil then exit;
115 Caret:=SrcEdit.CursorTextXY;
116 ErrMsg:='';
117
118 // check cursor is in a class
119 if not CodeToolBoss.FindEmptyMethods(Code,'',Caret.X,Caret.Y,
120 AllPascalClassSections,ListOfPCodeXYPosition,AllEmpty)
121 then begin
122 DebugLn(['ShowEmptyMethodsDialog CodeToolBoss.FindEmptyMethods failed']);
123 if CodeToolBoss.ErrorMessage<>'' then begin
124 ErrMsg:='';
125 LazarusIDE.DoJumpToCodeToolBossError;
126 end else begin
127 IDEMessageDialog(lisEMDNoClass,
128 Format(lisEMDNoClassAt, [Code.Filename, IntToStr(Caret.Y), IntToStr(
129 Caret.X)]),
130 mtError,[mbCancel]);
131 end;
132 exit;
133 end;
134 CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
135
136 EmptyMethodsDialog:=TEmptyMethodsDialog.Create(nil);
137 try
138 EmptyMethodsDialog.Code:=Code;
139 EmptyMethodsDialog.Caret:=Caret;
140 EmptyMethodsDialog.UpdateList;
141 Result:=EmptyMethodsDialog.ShowModal;
142 finally
143 EmptyMethodsDialog.Free;
144 end;
145 finally
146 CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
147 if ErrMsg<>'' then begin
148 IDEMessageDialog(lisCCOErrorCaption,
149 Format(lisEMDUnableToShowEmptyMethodsOfTheCurrentClassBecause,
150 [LineEnding, ErrMsg]), mtError, [mbCancel]);
151 end;
152 end;
153 end;
154
GetInheritedMethodnull155 function GetInheritedMethod(APersistent: TPersistent; PropInfo: PPropInfo): TMethod;
156 var
157 AncestorRoot, AncestorComponent: TComponent;
158 AncestorMethod: TMethod;
159 Comp: TComponent;
160 begin
161 FillByte(Result{%H-}, SizeOf(Result), 0);
162 if APersistent is TComponent then
163 begin
164 Comp := TComponent(APersistent);
165 if csAncestor in Comp.ComponentState then
166 begin
167 // search for ancestor component
168 if Assigned(Comp.Owner) then
169 begin
170 AncestorRoot := BaseFormEditor1.GetAncestorLookupRoot(Comp);
171 if Assigned(AncestorRoot) then
172 AncestorComponent := AncestorRoot.FindComponent(Comp.Name)
173 else
174 AncestorComponent := nil;
175 end
176 else
177 AncestorComponent := BaseFormEditor1.GetAncestorInstance(Comp);
178
179 if Assigned(AncestorComponent) then
180 begin
181 AncestorMethod := GetMethodProp(AncestorComponent, PropInfo);
182 if IsJITMethod(AncestorMethod) then
183 Result := AncestorMethod
184 end;
185 end;
186 end;
187 end;
188
RemoveEmptyMethodsInUnitnull189 function RemoveEmptyMethodsInUnit(Code: TCodeBuffer; AClassName: string;
190 X, Y: integer; Sections: TPascalClassSections): TModalResult;
191 var
192 RemovedProcHeads: TStrings;
193 PropChanged: boolean;
194
ExtractClassNamenull195 function ExtractClassName: string;
196 var
197 ProcName: string;
198 p: LongInt;
199 i: Integer;
200 begin
201 Result:='';
202 for i:=RemovedProcHeads.Count-1 downto 0 do
203 begin
204 ProcName:=RemovedProcHeads[i];
205 p:=System.Pos('.',ProcName);
206 if p<1 then
207 RemovedProcHeads.Delete(i)
208 else begin
209 Result:=copy(ProcName,1,p-1);
210 RemovedProcHeads[i]:=copy(ProcName,p+1,length(ProcName));
211 end;
212 end;
213 end;
214
215 procedure CheckEvents(APersistent: TPersistent);
216 // Read properties and remove event handlers which were removed from source by Codetools.
217 var
218 TypeInfo: PTypeInfo;
219 PropInfo: PPropInfo;
220 PropList: PPropList;
221 PropCount, ic, i: integer;
222 AMethod: TMethod;
223 AMethodName: String;
224 Coll: TCollection;
225 begin
226 TypeInfo:=PTypeInfo(APersistent.ClassInfo);
227 PropCount:=GetPropList(TypeInfo,PropList); // List of properties and their count
228 try
229 for ic:=0 to PropCount-1 do // iterate properties
230 begin
231 PropInfo:=PropList^[ic];
232 if PropInfo^.PropType^.Kind=tkMethod then
233 begin
234 AMethod:=GetMethodProp(APersistent,PropInfo); // event
235 AMethodName:=GlobalDesignHook.GetMethodName(AMethod,nil);
236 if AMethodName<>'' then
237 begin
238 i:=RemovedProcHeads.Count-1;
239 while (i>=0) and (CompareText(RemovedProcHeads[i],AMethodName)<>0) do
240 dec(i);
241 if i>=0 then
242 begin
243 //DebugLn([' CheckEvents Clearing Property=',PropInfo^.Name,' AMethodName=',AMethodName]);
244 AMethod := GetInheritedMethod(APersistent, PropInfo);
245 SetMethodProp(APersistent, PropInfo, AMethod);
246 PropChanged:=true;
247 end;
248 end;
249 end
250 else if PropInfo^.PropType^.Kind=tkClass then
251 begin
252 Coll := TCollection(GetObjectProp(APersistent, PropInfo, TCollection));
253 if Assigned(Coll) then
254 for i := 0 to Coll.Count - 1 do // CollectionItem can have events.
255 CheckEvents(Coll.Items[i]); // Recurse also because collections can be nested.
256 end;
257 end;
258 finally
259 FreeMem(PropList);
260 end;
261 end;
262
263 var
264 AllEmpty: boolean;
265 AnUnitInfo: TUnitInfo;
266 i: Integer;
267 LookupRoot: TComponent;
268 CurClassName: String;
269 begin
270 Result:=mrCancel;
271 RemovedProcHeads:=nil;
272 try
273 if not CodeToolBoss.RemoveEmptyMethods(Code,AClassName,X,Y,Sections,AllEmpty,
274 [phpAddClassName,phpDoNotAddSemicolon,phpWithoutParamList,
275 phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon],
276 RemovedProcHeads)
277 then begin
278 DebugLn(['RemoveEmptyMethods failed']);
279 exit;
280 end;
281 if (RemovedProcHeads<>nil) and (RemovedProcHeads.Count>0) then begin
282 // RemovedProcHeads contains a list of classname.procname, remove classname from the list
283 CurClassName:=ExtractClassName;
284 if (CurClassName<>'') and (Project1<>nil) then
285 begin
286 AnUnitInfo:=Project1.UnitInfoWithFilename(Code.Filename);
287 if AnUnitInfo<>nil then
288 begin
289 // fix events of designer components
290 LookupRoot:=AnUnitInfo.Component;
291 if (LookupRoot<>nil) and (CompareText(LookupRoot.ClassName,CurClassName)=0) then
292 begin
293 PropChanged:=false;
294 CheckEvents(LookupRoot);
295 for i:=0 to LookupRoot.ComponentCount-1 do
296 CheckEvents(LookupRoot.Components[i]);
297 // update objectinspector
298 if PropChanged and (GlobalDesignHook.LookupRoot=LookupRoot) then
299 GlobalDesignHook.RefreshPropertyValues;
300 end;
301 end;
302 end;
303 end;
304 finally
305 RemovedProcHeads.Free;
306 end;
307 Result:=mrOk;
308 end;
309
310 { TEmptyMethodsDialog }
311
312 procedure TEmptyMethodsDialog.FormCreate(Sender: TObject);
313 begin
314 Caption:=lisEMDEmptyMethods;
315 SectionsGroupBox.Caption:=lisEMDSearchInTheseClassSections;
316 PrivateCheckBox.Caption:=lisPrivate;
317 ProtectedCheckBox.Caption:=lisProtected;
318 PublicCheckBox.Caption:=lisEMDPublic;
319 PublishedCheckBox.Caption:=lisEMDPublished;
320 AllButton.Caption:=lisEMDAll;
321 PublishedButton.Caption:=lisEMDOnlyPublished;
322 MethodsGroupBox.Caption:=lisEMDFoundEmptyMethods;
323 Sections:=AllPascalClassSections;
324
325 ButtonPanel1.OKButton.Caption:=lisEMDRemoveMethods;
326 ButtonPanel1.CancelButton.Caption:=lisCancel;
327
328 EditorOpts.GetSynEditSettings(MethodsSynEdit);
329 end;
330
331 procedure TEmptyMethodsDialog.OKButtonClick(Sender: TObject);
332 begin
333 if LazarusIDE.BeginCodeTools
334 and (RemoveEmptyMethodsInUnit(Code,'',Caret.X,Caret.Y,Sections)=mrOk) then
335 ModalResult:=mrOk;
336 end;
337
338 procedure TEmptyMethodsDialog.PrivateCheckBoxChange(Sender: TObject);
339 begin
340 UpdateList;
341 end;
342
343 procedure TEmptyMethodsDialog.PublishedButtonClick(Sender: TObject);
344 begin
345 Sections:=[pcsPublished];
346 end;
347
348 procedure TEmptyMethodsDialog.SetSections(const AValue: TPascalClassSections);
349 begin
350 PrivateCheckBox.Checked:=pcsPrivate in AValue;
351 ProtectedCheckBox.Checked:=pcsProtected in AValue;
352 PublicCheckBox.Checked:=pcsPublic in AValue;
353 PublishedCheckBox.Checked:=pcsPublished in AValue;
354 end;
355
356 procedure TEmptyMethodsDialog.SetCaret(const AValue: TPoint);
357 begin
358 FCaret:=AValue;
359 end;
360
GetSectionsnull361 function TEmptyMethodsDialog.GetSections: TPascalClassSections;
362 begin
363 Result:=[];
364 if PrivateCheckBox.Checked then Include(Result,pcsPrivate);
365 if ProtectedCheckBox.Checked then Include(Result,pcsProtected);
366 if PublicCheckBox.Checked then Include(Result,pcsPublic);
367 if PublishedCheckBox.Checked then Include(Result,pcsPublished);
368 end;
369
370 procedure TEmptyMethodsDialog.SetCode(const AValue: TCodeBuffer);
371 begin
372 if FCode=AValue then exit;
373 FCode:=AValue;
374 end;
375
376 procedure TEmptyMethodsDialog.UpdateList;
377 var
378 CurSections: TPascalClassSections;
379 ListOfPCodeXYPosition: TFPList;
380 i: Integer;
381 CodePos: TCodeXYPosition;
382 Tool: TCodeTool;
383 CleanPos: integer;
384 Node: TCodeTreeNode;
385 NodeText: String;
386 AllEmpty: boolean;
387 NewTxt: String;
388 begin
389 if (Code=nil) or (Caret.X<1) or (Caret.Y<1) then begin
390 MethodsSynEdit.Text:='';
391 exit;
392 end;
393
394 CurSections:=Sections;
395 ListOfPCodeXYPosition:=TFPList.Create;
396 try
397 if (not CodeToolBoss.FindEmptyMethods(Code,'',Caret.X,Caret.Y,
398 CurSections,ListOfPCodeXYPosition,AllEmpty))
399 or (not CodeToolBoss.Explore(Code,Tool,false))
400 then begin
401 MethodsSynEdit.Text:='CodeToolBoss.FindEmptyMethods failed'#10
402 +CodeToolBoss.ErrorMessage;
403 exit;
404 end;
405
406 NewTxt:='';
407 for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
408 CodePos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
409 //DebugLn(['TEmptyMethodsDialog.UpdateList ',i,' ',DbgsCXY(CodePos)]);
410 if Tool.CaretToCleanPos(CodePos,CleanPos)<>0 then begin
411 DebugLn(['TEmptyMethodsDialog.UpdateList Tool.CaretToCleanPos failed']);
412 continue;
413 end;
414 Node:=Tool.FindDeepestNodeAtPos(CleanPos,false);
415 if Node=nil then begin
416 DebugLn(['TEmptyMethodsDialog.UpdateList Tool.FindDeepestNodeAtPos failed']);
417 continue;
418 end;
419 NodeText:=Tool.ExtractProcHead(Node,[phpWithStart,phpWithParameterNames,
420 phpWithVarModifiers,phpWithDefaultValues,phpWithResultType,
421 phpWithCallingSpecs,phpWithProcModifiers]);
422 NewTxt:=NewTxt+NodeText+#10;
423 end;
424 MethodsSynEdit.Text:=NewTxt;
425 finally
426 CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
427 end;
428 end;
429
430 procedure TEmptyMethodsDialog.AllButtonClick(Sender: TObject);
431 begin
432 Sections:=AllPascalClassSections;
433 end;
434
435 end.
436
437