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 Dialog for the Extract Proc feature.
25 Allows user choose what kind of procedure/function to create and
26 shows missing identifiers.
27 }
28 unit ExtractProcDlg;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 Classes, SysUtils, Laz_AVL_Tree,
36 // LCL
37 Forms, Controls, Dialogs, ExtCtrls, StdCtrls, ButtonPanel, LCLProc,
38 // LazUtils
39 LazUTF8,
40 // Codetools
41 BasicCodeTools, CodeTree, CodeCache, CodeToolManager, ExtractProcTool,
42 // IdeIntf
43 IDEHelpIntf, IDEDialogs,
44 // IDE
45 LazarusIDEStrConsts, MiscOptions, EnvironmentOpts;
46
47 type
48
49 { TExtractProcDialog }
50
51 TExtractProcDialog = class(TForm)
52 ButtonPanel: TButtonPanel;
53 FuncVariableComboBox: TComboBox;
54 CreateFunctionCheckBox: TCheckBox;
55 FunctionGroupBox: TGroupBox;
56 FuncVariableLabel: TLabel;
57 MissingIdentifiersListBox: TListBox;
58 MissingIdentifiersGroupBox: TGroupBox;
59 NameEdit: TEdit;
60 NameGroupbox: TGroupBox;
61 TypeRadiogroup: TRadioGroup;
62 procedure CreateFunctionCheckBoxChange(Sender: TObject);
63 procedure HelpButtonClick(Sender: TObject);
64 procedure ExtractProcDialogCreate(Sender: TObject);
65 procedure ExtractProcDialogClose(Sender: TObject;
66 var {%H-}CloseAction: TCloseAction);
67 procedure OkButtonClick(Sender: TObject);
68 private
69 FMethodPossible: boolean;
70 FMissingIdentifiers: TAVLTree;
71 FSubProcPossible: boolean;
72 FSubProcSameLvlPossible: boolean;
73 FVariables: TAVLTree;
74 procedure SetMissingIdentifiers(const AValue: TAVLTree);
75 procedure SetVariables(const AValue: TAVLTree);
VarNodeToStrnull76 function VarNodeToStr(Variable: TExtractedProcVariable): string;
77 public
78 procedure UpdateAvailableTypes;
79 procedure UpdateFunction;
GetProcTypenull80 function GetProcType: TExtractProcType;
GetProcNamenull81 function GetProcName: string;
GetFunctionNodenull82 function GetFunctionNode: TCodeTreeNode;
83
84 property MethodPossible: boolean read FMethodPossible write FMethodPossible;
85 property SubProcPossible: boolean read FSubProcPossible write FSubProcPossible;
86 property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible;
87 property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers;
88 property Variables: TAVLTree read FVariables write SetVariables;// tree of TExtractedProcVariable
89 end;
90
ShowExtractProcDialognull91 function ShowExtractProcDialog(Code: TCodeBuffer;
92 const BlockBegin, BlockEnd: TPoint;
93 out NewSource: TCodeBuffer;
94 out NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer): TModalResult;
95
96 implementation
97
98 {$R *.lfm}
99
ShowExtractProcDialognull100 function ShowExtractProcDialog(Code: TCodeBuffer; const BlockBegin,
101 BlockEnd: TPoint; out NewSource: TCodeBuffer; out NewX, NewY, NewTopLine,
102 BlockTopLine, BlockBottomLine: integer): TModalResult;
103 var
104 ExtractProcDialog: TExtractProcDialog;
105 MethodPossible: Boolean;
106 SubProcSameLvlPossible: boolean;
107 ProcName: String;
108 ProcType: TExtractProcType;
109 MissingIdentifiers: TAVLTree;
110 VarTree: TAVLTree;
111 FuncNode: TCodeTreeNode;
112 FunctionResultVariableStartPos: Integer;
113 SubProcPossible: boolean;
114 begin
115 Result:=mrCancel;
116 NewSource:=nil;
117 NewX:=0;
118 NewY:=0;
119 NewTopLine:=0;
120 BlockTopLine:=0;
121 BlockBottomLine:=0;
122 if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
123 IDEMessageDialog(lisNoCodeSelected,
124 lisPleaseSelectSomeCodeToExtractANewProcedureMethod,
125 mtInformation,[mbCancel]);
126 exit;
127 end;
128
129 MissingIdentifiers:=nil;
130 VarTree:=nil;
131 try
132 VarTree:=CreateExtractProcVariableTree;
133 // check if selected statements can be extracted
134 if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
135 SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,VarTree)
136 then begin
137 if CodeToolBoss.ErrorMessage='' then begin
138 IDEMessageDialog(lisInvalidSelection,
139 Format(lisThisStatementCanNotBeExtractedPleaseSelectSomeCode, [LineEnding]),
140 mtInformation,[mbCancel]);
141 end;
142 exit;
143 end;
144
145 // ask user how to extract
146 ExtractProcDialog:=TExtractProcDialog.Create(nil);
147 try
148 ExtractProcDialog.MethodPossible:=MethodPossible;
149 ExtractProcDialog.SubProcPossible:=SubProcPossible;
150 ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
151 ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers;
152 ExtractProcDialog.UpdateAvailableTypes;
153 ExtractProcDialog.Variables:=VarTree;
154 Result:=ExtractProcDialog.ShowModal;
155 if Result<>mrOk then exit;
156 ProcName:=ExtractProcDialog.GetProcName;
157 ProcType:=ExtractProcDialog.GetProcType;
158 FuncNode:=ExtractProcDialog.GetFunctionNode;
159 FunctionResultVariableStartPos:=0;
160 if (FuncNode<>nil) then
161 FunctionResultVariableStartPos:=FuncNode.StartPos;
162 finally
163 ExtractProcDialog.Free;
164 end;
165
166 // extract procedure/method
167 if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName,
168 MissingIdentifiers,NewSource,NewX,NewY,NewTopLine, BlockTopLine, BlockBottomLine,
169 FunctionResultVariableStartPos)
170 then begin
171 Result:=mrCancel;
172 exit;
173 end;
174 Result:=mrOk;
175 finally
176 ClearExtractProcVariableTree(VarTree,true);
177 CodeToolBoss.FreeTreeOfPCodeXYPosition(MissingIdentifiers);
178 end;
179 end;
180
181 { TExtractProcDialog }
182
183 procedure TExtractProcDialog.ExtractProcDialogCreate(Sender: TObject);
184 begin
185 Caption:=lisExtractProcedure;
186 NameGroupbox.Caption:=lisNameOfNewProcedure;
187 TypeRadiogroup.Caption:=dlgEnvType;
188 NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
189 MissingIdentifiersGroupBox.Caption:=lisMissingIdentifiers;
190
191 FunctionGroupBox.Caption:=lisFunction;
CreateFunctionCheckBox.Captionnull192 CreateFunctionCheckBox.Caption:=lisCreateFunction;
193 FuncVariableLabel.Caption:=lisResult2;
194
195 ButtonPanel.OkButton.Caption:=lisExtract;
196 FuncVariableComboBox.DropDownCount:=EnvironmentOptions.DropDownCount;
197 end;
198
199 procedure TExtractProcDialog.HelpButtonClick(Sender: TObject);
200 begin
201 LazarusHelp.ShowHelpForIDEControl(Self);
202 end;
203
204 procedure TExtractProcDialog.CreateFunctionCheckBoxChange(Sender: TObject);
205 begin
206 FuncVariableComboBox.Enabled:=CreateFunctionCheckBox.Checked;
207 FuncVariableLabel.Enabled:=FuncVariableComboBox.Enabled;
208 end;
209
210 procedure TExtractProcDialog.ExtractProcDialogClose(Sender: TObject;
211 var CloseAction: TCloseAction);
212 begin
213 MiscellaneousOptions.ExtractProcName:=NameEdit.Text;
214 end;
215
216 procedure TExtractProcDialog.OkButtonClick(Sender: TObject);
217 var
218 ProcName: String;
219 begin
220 ProcName:=GetProcName;
221 if not IsValidIdent(ProcName) then begin
222 IDEMessageDialog(lisInvalidProcName,
223 Format(lisSVUOisNotAValidIdentifier, [ProcName]), mtError,[mbCancel]);
224 ModalResult:=mrNone;
225 exit;
226 end;
227 ModalResult:=mrOk;
228 end;
229
230 procedure TExtractProcDialog.SetMissingIdentifiers(const AValue: TAVLTree);
231 var
232 Node: TAVLTreeNode;
233 CodePos: PCodeXYPosition;
234 p: integer;
235 Identifier: string;
236 s: String;
237 begin
238 if AValue=FMissingIdentifiers then exit;
239 FMissingIdentifiers:=AValue;
240 MissingIdentifiersListBox.Items.BeginUpdate;
241 MissingIdentifiersListBox.Items.Clear;
242 if FMissingIdentifiers<>nil then begin
243 Node:=FMissingIdentifiers.FindLowest;
244 while Node<>nil do begin
245 CodePos:=PCodeXYPosition(Node.Data);
246 CodePos^.Code.LineColToPosition(CodePos^.Y,CodePos^.X,p);
247 if p>=1 then
248 Identifier:=GetIdentifier(@CodePos^.Code.Source[p])
249 else
250 Identifier:='?';
251 s:=Identifier+' at '+IntToStr(CodePos^.Y)+','+IntToStr(CodePos^.X);
252 MissingIdentifiersListBox.Items.Add(s);
253 Node:=FMissingIdentifiers.FindSuccessor(Node);
254 end;
255 end;
256 MissingIdentifiersListBox.Items.EndUpdate;
257
258 // show/hide the MissingIdentifiersGroupBox
259 MissingIdentifiersGroupBox.Visible:=MissingIdentifiersListBox.Items.Count>0;
260 end;
261
262 procedure TExtractProcDialog.SetVariables(const AValue: TAVLTree);
263 begin
264 if FVariables=AValue then exit;
265 FVariables:=AValue;
266 UpdateFunction;
endnull267 end;
268
TExtractProcDialog.VarNodeToStrnull269 function TExtractProcDialog.VarNodeToStr(Variable: TExtractedProcVariable
270 ): string;
271 begin
272 if Variable.Node.Desc=ctnVarDefinition then
273 Result:=Variable.Tool.ExtractDefinitionName(Variable.Node)
274 +' : '+Variable.Tool.ExtractDefinitionNodeType(Variable.Node)
275 else
276 Result:='';
277 end;
278
279 procedure TExtractProcDialog.UpdateAvailableTypes;
280 begin
281 with TypeRadiogroup.Items do begin
282 BeginUpdate;
283 Clear;
284 if MethodPossible then begin
285 Add(lisPublicMethod);
286 Add(lisPrivateMethod);
287 Add(lisProtectedMethod);
288 Add(lisPublishedMethod);
289 TypeRadiogroup.Columns:=2;
290 end else begin
291 TypeRadiogroup.Columns:=1;
292 end;
293 Add(lisProcedureWithInterface);
294 Add(lisProcedure);
295 if SubProcPossible then begin
296 Add(lisSubProcedure);
297 if SubProcSameLvlPossible then
298 Add(lisSubProcedureOnSameLevel);
299 end;
300 EndUpdate;
301 TypeRadiogroup.ItemIndex:=Count-1;
302 end;
303 end;
304
305 procedure TExtractProcDialog.UpdateFunction;
306 var
307 AVLNode: TAVLTreeNode;
308 Variable: TExtractedProcVariable;
309 sl: TStringListUTF8Fast;
310 begin
311 FuncVariableComboBox.Items.BeginUpdate;
312 FuncVariableComboBox.Items.Clear;
313 if Variables<>nil then begin
314 sl:=TStringListUTF8Fast.Create;
315 try
316 AVLNode:=Variables.FindLowest;
317 while AVLNode<>nil do begin
318 Variable:=TExtractedProcVariable(AVLNode.Data);
319 if Variable.WriteInSelection then begin
320 //DebugLn(['TExtractProcDialog.UpdateFunction ',Variable.Node.DescAsString]);
321 if Variable.Node.Desc=ctnVarDefinition then begin
322 sl.Add(VarNodeToStr(Variable));
323 end;
324 end;
325 AVLNode:=Variables.FindSuccessor(AVLNode);
326 end;
327 sl.Sort;
328 FuncVariableComboBox.Items.Assign(sl);
329 if FuncVariableComboBox.Items.Count>0 then
330 FuncVariableComboBox.Text:=FuncVariableComboBox.Items[0];
331 FuncVariableComboBox.ItemIndex:=0;
332 finally
333 sl.Free;
334 end;
335 end;
336 FuncVariableComboBox.Items.EndUpdate;
337 FuncVariableComboBox.Enabled:=CreateFunctionCheckBox.Checked;
338 FuncVariableLabel.Enabled:=FuncVariableComboBox.Enabled;
339 FunctionGroupBox.Visible:=FuncVariableComboBox.Items.Count>0;
340 end;
341
GetProcTypenull342 function TExtractProcDialog.GetProcType: TExtractProcType;
343 var
344 Item: string;
345 begin
346 Result:=eptSubProcedure;
347 if TypeRadiogroup.ItemIndex>=0 then begin
348 Item:=TypeRadiogroup.Items[TypeRadiogroup.ItemIndex];
349 if Item=lisPublicMethod then Result:=eptPublicMethod
350 else if Item=lisPrivateMethod then Result:=eptPrivateMethod
351 else if Item=lisProtectedMethod then Result:=eptProtectedMethod
352 else if Item=lisPublishedMethod then Result:=eptPublishedMethod
353 else if Item=lisProcedure then Result:=eptProcedure
354 else if Item=lisProcedureWithInterface then Result:=eptProcedureWithInterface
355 else if Item=lisSubProcedure then Result:=eptSubProcedure
356 else if Item=lisSubProcedureOnSameLevel then Result:=eptSubProcedureSameLvl;
357 end;
358 end;
359
TExtractProcDialog.GetProcNamenull360 function TExtractProcDialog.GetProcName: string;
361 begin
362 Result:=NameEdit.Text;
363 end;
364
TExtractProcDialog.GetFunctionNodenull365 function TExtractProcDialog.GetFunctionNode: TCodeTreeNode;
366 var
367 AVLNode: TAVLTreeNode;
368 s: String;
369 Find: String;
370 Variable: TExtractedProcVariable;
371 begin
372 Result:=nil;
373 if (Variables=nil) or (not CreateFunctionCheckBox.Checked) then exit;
374 Find:=FuncVariableComboBox.Text;
375 AVLNode:=Variables.FindLowest;
376 while AVLNode<>nil do begin
377 Variable:=TExtractedProcVariable(AVLNode.Data);
378 if Variable.WriteInSelection then begin
379 //DebugLn(['TExtractProcDialog.UpdateFunction ',Variable.Node.DescAsString]);
380 if Variable.Node.Desc=ctnVarDefinition then begin
381 s:=VarNodeToStr(Variable);
382 if s=Find then begin
383 Result:=Variable.Node;
384 exit;
385 end;
386 end;
387 end;
388 AVLNode:=Variables.FindSuccessor(AVLNode);
389 end;
390 end;
391
392 end.
393
394