1 { Copyright (C) 2011,
2
3 ***************************************************************************
4 * *
5 * This source is free software; you can redistribute it and/or modify *
6 * it under the terms of the GNU General Public License as published by *
7 * the Free Software Foundation; either version 2 of the License, or *
8 * (at your option) any later version. *
9 * *
10 * This code is distributed in the hope that it will be useful, but *
11 * WITHOUT ANY WARRANTY; without even the implied warranty of *
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
13 * General Public License for more details. *
14 * *
15 * A copy of the GNU General Public License is available on the World *
16 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
17 * obtain it by writing to the Free Software Foundation, *
18 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
19 * *
20 ***************************************************************************
21
22 Original version by Juha Manninen
23 Icons added by Marcelo B Paula
24 All available units added to the list by Anton Panferov
25 }
26 unit UseUnitDlg;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils,
34 // LCL
35 LCLType, Forms, Controls, StdCtrls, ExtCtrls, ButtonPanel, Dialogs, Graphics,
36 // LazControls
37 ListFilterEdit,
38 // LazUtils
39 LazUTF8, LazFileUtils,
40 // Codetools
41 FileProcs, LinkScanner, CodeCache, CodeTree, CodeToolManager, IdentCompletionTool,
42 // BuildIntf
43 ProjectIntf,
44 // IdeIntf
45 LazIDEIntf, IDEImagesIntf, IDEWindowIntf,
46 // IDE
47 LazarusIDEStrConsts, SourceEditor, Project, EnvironmentOpts, MainIntf;
48
49 type
50
51 TUseUnitDialogType = (udUseUnit, udOpenUnit);
52
53 { TUseUnitDialog }
54
55 TUseUnitDialog = class(TForm)
56 ButtonPanel1: TButtonPanel;
57 AllUnitsCheckBox: TCheckBox;
58 FilterEdit: TListFilterEdit;
59 UnitsListBox: TListBox;
60 SectionRadioGroup: TRadioGroup;
61 procedure AllUnitsCheckBoxChange(Sender: TObject);
62 procedure FilterEditAfterFilter(Sender: TObject);
63 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
64 procedure FormCreate(Sender: TObject);
65 procedure FormDestroy(Sender: TObject);
66 procedure SectionRadioGroupClick(Sender: TObject);
67 procedure UnitsListBoxDblClick(Sender: TObject);
68 procedure UnitsListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
69 ARect: TRect; State: TOwnerDrawState);
70 procedure UnitsListBoxKeyDown(Sender: TObject; var Key: Word;
71 Shift: TShiftState);
72 procedure UnitsListBoxMeasureItem({%H-}Control: TWinControl; {%H-}Index: Integer;
73 var AHeight: Integer);
74 private
75 UnitImgInd: Integer;
76 FMainUsedUnits, FImplUsedUnits: TStringList;
77 FProjUnits, FOtherUnits: TStringListUTF8Fast;
78 DlgType: TUseUnitDialogType;
79 procedure AddImplUsedUnits;
GetProjUnitsnull80 function GetProjUnits(SrcEdit: TSourceEditor): Boolean;
81 procedure CreateOtherUnitsList;
SelectedUnitFileNamenull82 function SelectedUnitFileName: string;
SelectedUnitnull83 function SelectedUnit: string;
InterfaceSelectednull84 function InterfaceSelected: Boolean;
85 procedure DetermineUsesSection(ACode: TCodeBuffer);
86 procedure FillAvailableUnitsList;
87 public
88
89 end;
90
ShowUseUnitDialognull91 function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult;
92
93 implementation
94
95 {$R *.lfm}
96
ShowUseUnitDialognull97 function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult;
98 var
99 UseUnitDlg: TUseUnitDialog;
100 SrcEdit: TSourceEditor;
101 s: String;
102 CTRes: Boolean;
103 EnvOptions: TUseUnitDlgOptions;
104 begin
105 Result:=mrOk;
106 if not LazarusIDE.BeginCodeTools then begin
107 debugln(['ShowUseUnitDialog LazarusIDE.BeginCodeTools failed']);
108 exit;
109 end;
110 // get cursor position
111 SrcEdit:=SourceEditorManager.ActiveEditor;
112 if SrcEdit=nil then begin
113 debugln(['ShowUseUnitDialog no SrcEdit']);
114 exit;
115 end;
116 UseUnitDlg:=TUseUnitDialog.Create(nil);
117 try
118 UseUnitDlg.DlgType := aDlgType;
119 case aDlgType of
120 udUseUnit: UseUnitDlg.Caption := dlgUseUnitCaption;
121 udOpenUnit: UseUnitDlg.Caption := lisOpenUnit;
122 end;
123
124 if not UseUnitDlg.GetProjUnits(SrcEdit) then begin
125 debugln(['ShowUseUnitDialog UseUnitDlg.GetProjUnits(SrcEdit) failed: ',SrcEdit.FileName]);
126 Exit(mrCancel);
127 end;
128 UseUnitDlg.FillAvailableUnitsList;
129 // there is only main uses section in program/library/package
130 if SrcEdit.GetProjectFile=Project1.MainUnitInfo then
131 // only main (interface) section is available
132 UseUnitDlg.SectionRadioGroup.Enabled := False
133 else
134 // automatic choice of dest uses-section by cursor position
135 UseUnitDlg.DetermineUsesSection(SrcEdit.CodeBuffer);
136
137 // Read recent properties
138 EnvOptions := EnvironmentOptions.UseUnitDlgOptions;
139 UseUnitDlg.AllUnitsCheckBox.Checked := EnvOptions.AllUnits;
140 UseUnitDlg.SectionRadioGroup.ItemIndex := Ord(EnvOptions.AddToImplementation);
141 UseUnitDlg.SectionRadioGroup.Visible := aDlgType=udUseUnit;
142
143 if (UseUnitDlg.FilterEdit.Items.Count = 0)
144 and UseUnitDlg.AllUnitsCheckBox.Checked then begin
145 // No available units. This may not be a pascal source file.
146 ShowMessage(dlgNoAvailableUnits);
147 Exit(mrCancel);
148 end;
149
150 UseUnitDlg.FilterEdit.Text := DefText;
151
152 // Show the dialog.
153 if UseUnitDlg.ShowModal=mrOk then begin
154
155 // Write recent properties
156 EnvOptions.AllUnits := UseUnitDlg.AllUnitsCheckBox.Checked;
157 if aDlgType=udUseUnit then
158 EnvOptions.AddToImplementation := Boolean(UseUnitDlg.SectionRadioGroup.ItemIndex);
159 EnvironmentOptions.UseUnitDlgOptions := EnvOptions;
160
161 case aDlgType of
162 udUseUnit:
163 begin
164 s:=UseUnitDlg.SelectedUnit;
165 if s <> '' then begin
166 if UseUnitDlg.InterfaceSelected then
167 CTRes := CodeToolBoss.AddUnitToMainUsesSection(SrcEdit.CodeBuffer, s, '')
168 else
169 CTRes:=CodeToolBoss.AddUnitToImplementationUsesSection(SrcEdit.CodeBuffer, s, '');
170 if not CTRes then begin
171 LazarusIDE.DoJumpToCodeToolBossError;
172 exit(mrCancel);
173 end;
174 end;
175 end;
176 udOpenUnit:
177 begin
178 s:=UseUnitDlg.SelectedUnitFileName;
179 if FileExistsUTF8(s) then
180 Result := MainIDEInterface.DoOpenEditorFile(s,-1,-1,[ofAddToRecent])
181 else
182 exit(mrCancel);
183 end;
184 end;
185 end;
186 finally
187 UseUnitDlg.Free;
188 CodeToolBoss.SourceCache.ClearAllSourceLogEntries;
189 end;
190 end;
191
192 { TUseUnitDialog }
193
194 procedure TUseUnitDialog.FormCreate(Sender: TObject);
195 begin
196 // Internationalization
197 IDEDialogLayoutList.ApplyLayout(Self, 500, 460);
198 AllUnitsCheckBox.Caption := dlgShowAllUnits;
199 SectionRadioGroup.Caption := dlgInsertSection;
200 SectionRadioGroup.Items.Clear;
201 SectionRadioGroup.Items.Add(dlgInsertInterface);
202 SectionRadioGroup.Items.Add(dlgInsertImplementation);
203 ButtonPanel1.OKButton.Caption:=lisMenuOk;
204 ButtonPanel1.CancelButton.Caption:=lisCancel;
205 UnitImgInd := IDEImages.LoadImage('item_unit');
206 FProjUnits:=TStringListUTF8Fast.Create;
207 end;
208
209 procedure TUseUnitDialog.FormDestroy(Sender: TObject);
210 begin
211 FOtherUnits.Free;
212 FProjUnits.Free;
213 FImplUsedUnits.Free;
214 FMainUsedUnits.Free;
215 end;
216
217 procedure TUseUnitDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction);
218 begin
219 IDEDialogLayoutList.SaveLayout(Self);
220 end;
221
222 procedure TUseUnitDialog.SectionRadioGroupClick(Sender: TObject);
223 var
224 i: Integer;
225 begin
226 if not Assigned(FImplUsedUnits) then Exit;
227 if InterfaceSelected then
228 AddImplUsedUnits
229 else
230 for i := FilterEdit.Items.Count - 1 downto 0 do
231 if FilterEdit.Items.Objects[i] is TCodeTreeNode then
232 FilterEdit.Items.Delete(i);
233 FilterEdit.InvalidateFilter;
234 if Visible then
235 FilterEdit.SetFocus;
236 end;
237
238 procedure TUseUnitDialog.AllUnitsCheckBoxChange(Sender: TObject);
239 var
240 i: Integer;
241 begin
242 if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
243 if AllUnitsCheckBox.Checked then begin // Add other units
244 if not Assigned(FOtherUnits) then
245 CreateOtherUnitsList;
246 FilterEdit.Items.AddStrings(FOtherUnits);
247 end
248 else
249 for i := FilterEdit.Items.Count-1 downto 0 do
250 if FilterEdit.Items.Objects[i] is TIdentifierListItem then
251 FilterEdit.Items.Delete(i);
252 if Visible then
253 FilterEdit.SetFocus;
254 FilterEdit.InvalidateFilter;
255 end;
256
257 procedure TUseUnitDialog.UnitsListBoxDblClick(Sender: TObject);
258 begin
259 if UnitsListBox.ItemIndex >= 0 then
260 ModalResult := mrOK;
261 end;
262
263 procedure TUseUnitDialog.UnitsListBoxDrawItem(Control: TWinControl;
264 Index: Integer; ARect: TRect; State: TOwnerDrawState);
265 var
266 ena: Boolean;
267 begin
268 if Index < 0 then Exit;
269 with UnitsListBox do
270 begin
271 Canvas.FillRect(ARect);
272 ena := not Assigned(Items.Objects[Index]) or (Items.Objects[Index] is TCodeTreeNode);
273 if not (ena or (odSelected in State)) then
274 Canvas.Font.Color := clGreen;
275 IDEImages.Images_16.Draw(Canvas, 1, (ARect.Top+ARect.Bottom-IDEImages.Images_16.Height) div 2, UnitImgInd, ena);
276 if Items.Objects[Index] is TCodeTreeNode then
277 begin
278 // unit for moving: implementation->interface
279 Canvas.Pen.Color := clBlue;
280 Canvas.Pen.Width := 2;
281 Canvas.MoveTo(ARect.Left + 13, ARect.Top + 16);
282 Canvas.LineTo(ARect.Left + 13, ARect.Top + 8);
283 Canvas.LineTo(ARect.Left + 10, ARect.Top + 11);
284 Canvas.MoveTo(ARect.Left + 13, ARect.Top + 8);
285 Canvas.LineTo(ARect.Left + 15, ARect.Top + 11);
286 end;
287 Canvas.TextRect(ARect, ARect.Left + IDEImages.Images_16.Width + 4, ARect.Top, Items[Index]);
288 end;
289 end;
290
291 procedure TUseUnitDialog.UnitsListBoxKeyDown(Sender: TObject; var Key: Word;
292 Shift: TShiftState);
293 begin
294 // A hack to prevent 'O' working as shortcut for OK-button.
295 // Should be removed when issue #20599 is resolved.
296 if (Key = VK_O) and (Shift = []) then
297 Key:=VK_UNKNOWN;
298 end;
299
300 procedure TUseUnitDialog.UnitsListBoxMeasureItem(Control: TWinControl;
301 Index: Integer; var AHeight: Integer);
302 begin
303 if (AHeight <= IDEImages.Images_16.Height) then
304 AHeight := IDEImages.Images_16.Height + 2;
305 end;
306
307 procedure TUseUnitDialog.AddImplUsedUnits;
308 var
309 i, j: Integer;
310 newUnit: string;
311 ImplNode: TObject;
312 begin
313 if FImplUsedUnits.Count = 0 then Exit;
314 i := 0; j := 0;
315 ImplNode := FImplUsedUnits.Objects[0];
316 newUnit := FImplUsedUnits[j];
317 with FilterEdit.Items do
318 begin
319 BeginUpdate;
320 try
321 while i <= Count - 1 do
322 begin
323 if Assigned(Objects[i]) then Break;
324 if CompareStr(FImplUsedUnits[j], Strings[i]) <= 0 then
325 begin
326 InsertObject(i, newUnit, ImplNode);
327 Inc(j);
328 if j >= FImplUsedUnits.Count then Exit;
329 newUnit := FImplUsedUnits[j];
330 end;
331 Inc(i);
332 end;
333 if j < FImplUsedUnits.Count then
334 for j := j to FImplUsedUnits.Count - 1 do
335 if i < Count then
336 InsertObject(i, FImplUsedUnits[j], ImplNode)
337 else
338 AddObject(FImplUsedUnits[j], ImplNode);
339 finally
340 EndUpdate;
341 end;
342 end;
343 end;
344
GetProjUnitsnull345 function TUseUnitDialog.GetProjUnits(SrcEdit: TSourceEditor): Boolean;
346 var
347 ProjFile: TUnitInfo;
348 CurrentUnitName, s: String;
349 x: Integer;
350 begin
351 Result := False;
352 FreeAndNil(FMainUsedUnits);
353 FreeAndNil(FImplUsedUnits);
354 if SrcEdit = nil then Exit;
355 Assert(Assigned(SrcEdit.CodeBuffer));
356 if DlgType=udUseUnit then
357 begin
358 if not CodeToolBoss.FindUsedUnitNames(SrcEdit.CodeBuffer, TStrings(FMainUsedUnits),
359 TStrings(FImplUsedUnits))
360 then begin
361 DebugLn(['ShowUseProjUnitDialog CodeToolBoss.FindUsedUnitNames failed']);
362 LazarusIDE.DoJumpToCodeToolBossError;
363 Exit;
364 end;
365 end else
366 begin
367 // don't filter units in current uses sections - use empty lists
368 FMainUsedUnits := TStringList.Create;
369 FImplUsedUnits := TStringList.Create;
370 end;
371 Result := True;
372 if Assigned(FMainUsedUnits) then
373 FMainUsedUnits.Sorted := True;
374 if Assigned(FImplUsedUnits) then
375 FImplUsedUnits.Sorted := True;
376 if SrcEdit.GetProjectFile is TUnitInfo then
377 CurrentUnitName := TUnitInfo(SrcEdit.GetProjectFile).Unit_Name
378 else
379 CurrentUnitName := '';
380 // Add available unit names to list
381 ProjFile:=Project1.FirstPartOfProject;
382 while ProjFile <> nil do begin
383 s := ProjFile.Unit_Name;
384 if s = CurrentUnitName then // current unit
385 s := '';
386 if (ProjFile <> Project1.MainUnitInfo) and (s <> '') then
387 if not FMainUsedUnits.Find(s, x) then
388 FProjUnits.AddObject(s, ProjFile);
389 ProjFile := ProjFile.NextPartOfProject;
390 end;
391 FProjUnits.Sorted := True;
392 end;
393
394 procedure TUseUnitDialog.CreateOtherUnitsList;
395 var
396 i, x: Integer;
397 curUnit: string;
398 SrcEdit: TSourceEditor;
399 begin
400 if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
401 Screen.BeginWaitCursor;
402 try
403 FOtherUnits := TStringListUTF8Fast.Create;
404 SrcEdit := SourceEditorManager.ActiveEditor;
405 with CodeToolBoss do
406 if GatherUnitNames(SrcEdit.CodeBuffer) then
407 begin
408 IdentifierList.Prefix := '';
409 for i := 0 to IdentifierList.GetFilteredCount - 1 do
410 begin
411 curUnit := IdentifierList.FilteredItems[i].Identifier;
412 if not FMainUsedUnits.Find(curUnit, x)
413 and not FImplUsedUnits.Find(curUnit, x)
414 and not FProjUnits.Find(curUnit, x) then
415 FOtherUnits.AddObject(IdentifierList.FilteredItems[i].Identifier,
416 IdentifierList.FilteredItems[i]);
417 end;
418 end;
419 FOtherUnits.Sorted := True;
420 finally
421 Screen.EndWaitCursor;
422 end;
423 end;
424
SelectedUnitnull425 function TUseUnitDialog.SelectedUnit: string;
426 var
427 IdentItem: TIdentifierListItem;
428 CodeBuf: TCodeBuffer;
429 s: String;
430 begin
431 with UnitsListBox do
432 if ItemIndex >= 0 then
433 begin
434 if Items.Objects[ItemIndex] is TIdentifierListItem then
435 begin
436 IdentItem := TIdentifierListItem(Items.Objects[ItemIndex]);
437 Result := IdentItem.Identifier;
438 with CodeToolBoss.SourceChangeCache.BeautifyCodeOptions do
439 if WordExceptions.CheckExceptions(Result) then Exit;
440 CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, Result, '');
441 if Assigned(CodeBuf) then
442 begin
443 s := CodeToolBoss.GetSourceName(CodeBuf, True);
444 if s <> '' then
445 Result := s;
446 end;
447 end else
448 Result := Items[ItemIndex];
449 end else
450 Result := '';
451 end;
452
SelectedUnitFileNamenull453 function TUseUnitDialog.SelectedUnitFileName: string;
454 var
455 CodeBuf: TCodeBuffer;
456 AObj: TObject;
457 begin
458 Result := '';
459 if UnitsListBox.ItemIndex < 0 then
460 Exit;
461 AObj := UnitsListBox.Items.Objects[UnitsListBox.ItemIndex];
462 if AObj is TIdentifierListItem then
463 begin
464 CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, TIdentifierListItem(AObj).Identifier, '');
465 if Assigned(CodeBuf) then
466 Result := CodeBuf.Filename;
467 end else
468 if AObj is TUnitInfo then
469 begin
470 Result := TUnitInfo(AObj).Filename;
471 end;
472 end;
473
InterfaceSelectednull474 function TUseUnitDialog.InterfaceSelected: Boolean;
475 begin
476 Result:=(not SectionRadioGroup.Enabled) or (SectionRadioGroup.ItemIndex=0);
477 end;
478
479 procedure TUseUnitDialog.DetermineUsesSection(ACode: TCodeBuffer);
480 var
481 ImplUsesNode: TCodeTreeNode;
482 i: Integer;
483 Tool: TCodeTool;
484 begin
485 CodeToolBoss.Explore(ACode,Tool,false);
486 if Tool=nil then exit;
487 // collect implementation use unit nodes
488 ImplUsesNode := Tool.FindImplementationUsesNode;
489 if Assigned(ImplUsesNode) then
490 for i := 0 to FImplUsedUnits.Count - 1 do
491 FImplUsedUnits.Objects[i] := ImplUsesNode;
492 // update
493 SectionRadioGroup.OnClick(SectionRadioGroup);
494 end;
495
496 procedure TUseUnitDialog.FillAvailableUnitsList;
497 var
498 curUnit: String;
499 i, x: Integer;
500 begin
501 if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
502 if not Assigned(FProjUnits) then Exit;
503 FilterEdit.Items.Clear;
504 for i := 0 to FProjUnits.Count - 1 do
505 begin
506 curUnit := FProjUnits[i];
507 if not FMainUsedUnits.Find(curUnit, x)
508 and not FImplUsedUnits.Find(curUnit, x) then
509 FilterEdit.Items.AddObject(FProjUnits[i], FProjUnits.Objects[i]);
510 end;
511 FilterEdit.InvalidateFilter;
512 end;
513
514 procedure TUseUnitDialog.FilterEditAfterFilter(Sender: TObject);
515 begin
516 if (UnitsListBox.Count > 0) and (UnitsListBox.ItemIndex = -1) then
517 UnitsListBox.ItemIndex := 0;
518 end;
519
520 end.
521
522