{ Copyright (C) 2011, *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Original version by Juha Manninen Icons added by Marcelo B Paula All available units added to the list by Anton Panferov } unit UseUnitDlg; {$mode objfpc}{$H+} interface uses Classes, SysUtils, // LCL LCLType, Forms, Controls, StdCtrls, ExtCtrls, ButtonPanel, Dialogs, Graphics, // LazControls ListFilterEdit, // LazUtils LazUTF8, LazFileUtils, LazUtilities, // Codetools FileProcs, LinkScanner, CodeCache, CodeTree, CodeToolManager, IdentCompletionTool, // BuildIntf ProjectIntf, // IdeIntf IdeIntfStrConsts, LazIDEIntf, IDEImagesIntf, IDEWindowIntf, TextTools, // IDE LazarusIDEStrConsts, SourceEditor, Project, EnvironmentOpts, MainIntf; type TUseUnitDialogType = (udUseUnit, udOpenUnit); { TUseUnitDialog } TUseUnitDialog = class(TForm) ButtonPanel1: TButtonPanel; AllUnitsCheckBox: TCheckBox; FilterEdit: TListFilterEdit; UnitsListBox: TListBox; SectionRadioGroup: TRadioGroup; procedure AllUnitsCheckBoxChange(Sender: TObject); procedure FilterEditAfterFilter(Sender: TObject); function FilterEditFilterItemEx(const ACaption: string; {%H-}ItemData: Pointer; out Done: Boolean): Boolean; procedure FilterEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SectionRadioGroupClick(Sender: TObject); procedure UnitsListBoxDblClick(Sender: TObject); procedure UnitsListBoxDrawItem({%H-}Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); private UnitImgInd: Integer; FMainUsedUnits, FImplUsedUnits: TStringList; FProjUnits, FOtherUnits: TStringListUTF8Fast; DlgType: TUseUnitDialogType; procedure AddImplUsedUnits; function GetProjUnits(SrcEdit: TSourceEditor): Boolean; procedure CreateOtherUnitsList; function SelectedUnitFileName: string; function SelectedUnit: string; function InterfaceSelected: Boolean; procedure DetermineUsesSection(ACode: TCodeBuffer); procedure FillAvailableUnitsList; public end; function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult; implementation {$R *.lfm} function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult; var UseUnitDlg: TUseUnitDialog; SrcEdit: TSourceEditor; s: String; CTRes: Boolean; EnvOptions: TUseUnitDlgOptions; begin Result:=mrOk; if not LazarusIDE.BeginCodeTools then begin debugln(['ShowUseUnitDialog LazarusIDE.BeginCodeTools failed']); exit; end; // get cursor position SrcEdit:=SourceEditorManager.ActiveEditor; if SrcEdit=nil then begin debugln(['ShowUseUnitDialog no SrcEdit']); exit; end; UseUnitDlg:=TUseUnitDialog.Create(nil); try UseUnitDlg.DlgType := aDlgType; case aDlgType of udUseUnit: UseUnitDlg.Caption := dlgUseUnitCaption; udOpenUnit: UseUnitDlg.Caption := lisOpenUnit; end; if not UseUnitDlg.GetProjUnits(SrcEdit) then begin debugln(['ShowUseUnitDialog UseUnitDlg.GetProjUnits(SrcEdit) failed: ',SrcEdit.FileName]); Exit(mrCancel); end; UseUnitDlg.FillAvailableUnitsList; // there is only main uses section in program/library/package if SrcEdit.GetProjectFile=Project1.MainUnitInfo then // only main (interface) section is available UseUnitDlg.SectionRadioGroup.Enabled := False else // automatic choice of dest uses-section by cursor position UseUnitDlg.DetermineUsesSection(SrcEdit.CodeBuffer); // Read recent properties EnvOptions := EnvironmentOptions.UseUnitDlgOptions; UseUnitDlg.AllUnitsCheckBox.Checked := EnvOptions.AllUnits; UseUnitDlg.SectionRadioGroup.ItemIndex := Ord(EnvOptions.AddToImplementation); UseUnitDlg.SectionRadioGroup.Visible := aDlgType=udUseUnit; if (UseUnitDlg.FilterEdit.Items.Count = 0) and UseUnitDlg.AllUnitsCheckBox.Checked then begin // No available units. This may not be a pascal source file. ShowMessage(dlgNoAvailableUnits); Exit(mrCancel); end; UseUnitDlg.FilterEdit.Text := DefText; // Show the dialog. if UseUnitDlg.ShowModal=mrOk then begin // Write recent properties EnvOptions.AllUnits := UseUnitDlg.AllUnitsCheckBox.Checked; if aDlgType=udUseUnit then EnvOptions.AddToImplementation := Boolean(UseUnitDlg.SectionRadioGroup.ItemIndex); EnvironmentOptions.UseUnitDlgOptions := EnvOptions; case aDlgType of udUseUnit: begin s:=UseUnitDlg.SelectedUnit; if s <> '' then begin if UseUnitDlg.InterfaceSelected then CTRes := CodeToolBoss.AddUnitToMainUsesSection(SrcEdit.CodeBuffer, s, '') else CTRes:=CodeToolBoss.AddUnitToImplementationUsesSection(SrcEdit.CodeBuffer, s, ''); if not CTRes then begin LazarusIDE.DoJumpToCodeToolBossError; exit(mrCancel); end; end; end; udOpenUnit: begin s:=UseUnitDlg.SelectedUnitFileName; if FileExistsUTF8(s) then Result := MainIDEInterface.DoOpenEditorFile(s,-1,-1,[ofAddToRecent]) else exit(mrCancel); end; end; end; finally UseUnitDlg.Free; CodeToolBoss.SourceCache.ClearAllSourceLogEntries; end; end; { TUseUnitDialog } procedure TUseUnitDialog.FormCreate(Sender: TObject); begin // Internationalization IDEDialogLayoutList.ApplyLayout(Self, 500, 460); AllUnitsCheckBox.Caption := dlgShowAllUnits; SectionRadioGroup.Caption := dlgInsertSection; SectionRadioGroup.Items.Clear; SectionRadioGroup.Items.Add(dlgInsertInterface); SectionRadioGroup.Items.Add(dlgInsertImplementation); ButtonPanel1.OKButton.Caption:=lisBtnOk; ButtonPanel1.CancelButton.Caption:=lisCancel; UnitImgInd := IDEImages.LoadImage('item_unit'); FProjUnits:=TStringListUTF8Fast.Create; UnitsListBox.ItemHeight := IDEImages.Images_16.Height + 2; end; procedure TUseUnitDialog.FormDestroy(Sender: TObject); begin FreeThenNil(FOtherUnits); FreeThenNil(FProjUnits); FreeThenNil(FImplUsedUnits); FreeThenNil(FMainUsedUnits); end; procedure TUseUnitDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Key = VK_A) and (Shift = [ssAlt]) then begin with AllUnitsCheckBox do Checked := not Checked; Key := 0; end; if (Key = VK_S) and (Shift = [ssAlt]) then begin with SectionRadioGroup do if Enabled then ItemIndex := (ItemIndex + 1) mod Items.Count; Key := 0; end; end; procedure TUseUnitDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin IDEDialogLayoutList.SaveLayout(Self); end; procedure TUseUnitDialog.SectionRadioGroupClick(Sender: TObject); var i: Integer; begin if not Assigned(FImplUsedUnits) then Exit; if InterfaceSelected then AddImplUsedUnits else for i := FilterEdit.Items.Count - 1 downto 0 do if FilterEdit.Items.Objects[i] is TCodeTreeNode then FilterEdit.Items.Delete(i); FilterEdit.InvalidateFilter; if Visible then FilterEdit.SetFocus; end; procedure TUseUnitDialog.AllUnitsCheckBoxChange(Sender: TObject); var i: Integer; begin if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit; if AllUnitsCheckBox.Checked then begin // Add other units if not Assigned(FOtherUnits) then CreateOtherUnitsList; FilterEdit.Items.AddStrings(FOtherUnits); end else for i := FilterEdit.Items.Count-1 downto 0 do if FilterEdit.Items.Objects[i] is TIdentifierListItem then FilterEdit.Items.Delete(i); if Visible then FilterEdit.SetFocus; FilterEdit.InvalidateFilter; end; procedure TUseUnitDialog.UnitsListBoxDblClick(Sender: TObject); begin if UnitsListBox.ItemIndex >= 0 then ModalResult := mrOK; end; procedure TUseUnitDialog.UnitsListBoxDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); var ena: Boolean; begin if Index < 0 then Exit; with UnitsListBox do begin Canvas.FillRect(ARect); ena := not Assigned(Items.Objects[Index]) or (Items.Objects[Index] is TCodeTreeNode); if not (ena or (odSelected in State)) then Canvas.Font.Color := clGreen; IDEImages.Images_16.Draw(Canvas, 1, (ARect.Top+ARect.Bottom-IDEImages.Images_16.Height) div 2, UnitImgInd, ena); if Items.Objects[Index] is TCodeTreeNode then begin // unit for moving: implementation->interface Canvas.Pen.Color := clBlue; Canvas.Pen.Width := 2; Canvas.MoveTo(ARect.Left + 13, ARect.Top + 16); Canvas.LineTo(ARect.Left + 13, ARect.Top + 8); Canvas.LineTo(ARect.Left + 10, ARect.Top + 11); Canvas.MoveTo(ARect.Left + 13, ARect.Top + 8); Canvas.LineTo(ARect.Left + 15, ARect.Top + 11); end; Canvas.TextRect(ARect, ARect.Left + IDEImages.Images_16.Width + 4, ARect.Top, Items[Index]); end; end; procedure TUseUnitDialog.AddImplUsedUnits; var i, j: Integer; newUnit: string; ImplNode: TObject; begin if FImplUsedUnits.Count = 0 then Exit; i := 0; j := 0; ImplNode := FImplUsedUnits.Objects[0]; newUnit := FImplUsedUnits[j]; with FilterEdit.Items do begin BeginUpdate; try while i <= Count - 1 do begin if Assigned(Objects[i]) then Break; if CompareStr(FImplUsedUnits[j], Strings[i]) <= 0 then begin InsertObject(i, newUnit, ImplNode); Inc(j); if j >= FImplUsedUnits.Count then Exit; newUnit := FImplUsedUnits[j]; end; Inc(i); end; if j < FImplUsedUnits.Count then for j := j to FImplUsedUnits.Count - 1 do if i < Count then InsertObject(i, FImplUsedUnits[j], ImplNode) else AddObject(FImplUsedUnits[j], ImplNode); finally EndUpdate; end; end; end; function TUseUnitDialog.GetProjUnits(SrcEdit: TSourceEditor): Boolean; var ProjFile: TUnitInfo; CurrentUnitName, s: String; x: Integer; begin Result := False; FreeThenNil(FMainUsedUnits); FreeThenNil(FImplUsedUnits); if SrcEdit = nil then Exit; Assert(Assigned(SrcEdit.CodeBuffer)); if DlgType=udUseUnit then begin if not CodeToolBoss.FindUsedUnitNames(SrcEdit.CodeBuffer, TStrings(FMainUsedUnits), TStrings(FImplUsedUnits)) then begin DebugLn(['ShowUseProjUnitDialog CodeToolBoss.FindUsedUnitNames failed']); LazarusIDE.DoJumpToCodeToolBossError; Exit; end; end else begin // don't filter units in current uses sections - use empty lists FMainUsedUnits := TStringList.Create; FImplUsedUnits := TStringList.Create; end; Result := True; if Assigned(FMainUsedUnits) then FMainUsedUnits.Sorted := True; if Assigned(FImplUsedUnits) then FImplUsedUnits.Sorted := True; if SrcEdit.GetProjectFile is TUnitInfo then CurrentUnitName := TUnitInfo(SrcEdit.GetProjectFile).Unit_Name else CurrentUnitName := ''; // Add available unit names to list for TLazProjectFile(ProjFile) in Project1.UnitsBelongingToProject do begin s := ProjFile.Unit_Name; if s = CurrentUnitName then // current unit s := ''; if (ProjFile <> Project1.MainUnitInfo) and (s <> '') then if not FMainUsedUnits.Find(s, x) then FProjUnits.AddObject(s, ProjFile); end; FProjUnits.Sorted := True; end; procedure TUseUnitDialog.CreateOtherUnitsList; var i, x: Integer; curUnit: string; SrcEdit: TSourceEditor; begin if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit; Screen.BeginWaitCursor; try FOtherUnits := TStringListUTF8Fast.Create; SrcEdit := SourceEditorManager.ActiveEditor; with CodeToolBoss do if GatherUnitNames(SrcEdit.CodeBuffer) then begin IdentifierList.Prefix := ''; for i := 0 to IdentifierList.GetFilteredCount - 1 do begin curUnit := IdentifierList.FilteredItems[i].Identifier; if not FMainUsedUnits.Find(curUnit, x) and not FImplUsedUnits.Find(curUnit, x) and not FProjUnits.Find(curUnit, x) then FOtherUnits.AddObject(IdentifierList.FilteredItems[i].Identifier, IdentifierList.FilteredItems[i]); end; end; FOtherUnits.Sorted := True; finally Screen.EndWaitCursor; end; end; function TUseUnitDialog.SelectedUnit: string; var IdentItem: TIdentifierListItem; CodeBuf: TCodeBuffer; s: String; begin with UnitsListBox do if ItemIndex >= 0 then begin if Items.Objects[ItemIndex] is TIdentifierListItem then begin IdentItem := TIdentifierListItem(Items.Objects[ItemIndex]); Result := IdentItem.Identifier; with CodeToolBoss.SourceChangeCache.BeautifyCodeOptions do if WordExceptions.CheckExceptions(Result) then Exit; CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, Result, ''); if Assigned(CodeBuf) then begin s := CodeToolBoss.GetSourceName(CodeBuf, True); if s <> '' then Result := s; end; end else Result := Items[ItemIndex]; end else Result := ''; end; function TUseUnitDialog.SelectedUnitFileName: string; var CodeBuf: TCodeBuffer; AObj: TObject; begin Result := ''; if UnitsListBox.ItemIndex < 0 then Exit; AObj := UnitsListBox.Items.Objects[UnitsListBox.ItemIndex]; if AObj is TIdentifierListItem then begin CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, TIdentifierListItem(AObj).Identifier, ''); if Assigned(CodeBuf) then Result := CodeBuf.Filename; end else if AObj is TUnitInfo then begin Result := TUnitInfo(AObj).Filename; end; end; function TUseUnitDialog.InterfaceSelected: Boolean; begin Result:=(not SectionRadioGroup.Enabled) or (SectionRadioGroup.ItemIndex=0); end; procedure TUseUnitDialog.DetermineUsesSection(ACode: TCodeBuffer); var ImplUsesNode: TCodeTreeNode; i: Integer; Tool: TCodeTool; begin CodeToolBoss.Explore(ACode,Tool,false); if Tool=nil then exit; // collect implementation use unit nodes ImplUsesNode := Tool.FindImplementationUsesNode; if Assigned(ImplUsesNode) then for i := 0 to FImplUsedUnits.Count - 1 do FImplUsedUnits.Objects[i] := ImplUsesNode; // update SectionRadioGroup.OnClick(SectionRadioGroup); end; procedure TUseUnitDialog.FillAvailableUnitsList; var curUnit: String; i, x: Integer; begin if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit; if not Assigned(FProjUnits) then Exit; FilterEdit.Items.Clear; for i := 0 to FProjUnits.Count - 1 do begin curUnit := FProjUnits[i]; if not FMainUsedUnits.Find(curUnit, x) and not FImplUsedUnits.Find(curUnit, x) then FilterEdit.Items.AddObject(FProjUnits[i], FProjUnits.Objects[i]); end; FilterEdit.InvalidateFilter; end; procedure TUseUnitDialog.FilterEditAfterFilter(Sender: TObject); begin if (UnitsListBox.Count > 0) and (UnitsListBox.ItemIndex < 0) then UnitsListBox.ItemIndex := 0; end; function TUseUnitDialog.FilterEditFilterItemEx(const ACaption: string; ItemData: Pointer; out Done: Boolean): Boolean; begin Done := true; result := MultiWordSearch(FilterEdit.Text, ACaption); end; procedure TUseUnitDialog.FilterEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var c: char; begin if KeyToQWERTY(Key, Shift, c, true) then FilterEdit.SelText := c; end; end.