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